{-# LANGUAGE PackageImports #-}
{-# LANGUAGE TypeApplications #-}
module Language.PureScript.Ide.State
( getLoadedModulenames
, getExternFiles
, getFileState
, resetIdeState
, cacheRebuild
, cachedRebuild
, insertExterns
, insertModule
, insertExternsSTM
, getAllModules
, populateVolatileState
, populateVolatileStateSync
, populateVolatileStateSTM
, getOutputDirectory
, updateCacheTimestamp
, resolveOperatorsForModule
, resolveInstances
, resolveDataConstructorsForModule
) where
import Protolude hiding (moduleName, unzip)
import Control.Concurrent.STM (TVar, modifyTVar, readTVar, readTVarIO, writeTVar)
import Control.Lens (Ixed(..), preview, view, (%~), (.~), (^.))
import "monad-logger" Control.Monad.Logger (MonadLogger, logWarnN)
import Data.IORef (readIORef, writeIORef)
import Data.Map.Lazy qualified as Map
import Data.Time.Clock (UTCTime)
import Data.Zip (unzip)
import Language.PureScript qualified as P
import Language.PureScript.Docs.Convert.Single (convertComments)
import Language.PureScript.Externs (ExternsDeclaration(..), ExternsFile(..))
import Language.PureScript.Make.Actions (cacheDbFile)
import Language.PureScript.Ide.Externs (convertExterns)
import Language.PureScript.Ide.Reexports (ReexportResult(..), prettyPrintReexportResult, reexportHasFailures, resolveReexports)
import Language.PureScript.Ide.SourceFile (extractAstInformation)
import Language.PureScript.Ide.Types
import Language.PureScript.Ide.Util (discardAnn, displayTimeSpec, logPerf, opNameT, properNameT, runLogger)
import System.Directory (getModificationTime)
resetIdeState :: Ide m => m ()
resetIdeState :: forall (m :: * -> *). Ide m => m ()
resetIdeState = do
TVar IdeState
ideVar <- IdeEnvironment -> TVar IdeState
ideStateVar forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall r (m :: * -> *). MonadReader r m => m r
ask
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (forall a. STM a -> IO a
atomically (forall a. TVar a -> a -> STM ()
writeTVar TVar IdeState
ideVar IdeState
emptyIdeState))
getOutputDirectory :: Ide m => m FilePath
getOutputDirectory :: forall (m :: * -> *). Ide m => m FilePath
getOutputDirectory = do
IdeConfiguration -> FilePath
confOutputPath forall b c a. (b -> c) -> (a -> b) -> a -> c
. IdeEnvironment -> IdeConfiguration
ideConfiguration forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall r (m :: * -> *). MonadReader r m => m r
ask
getCacheTimestamp :: Ide m => m (Maybe UTCTime)
getCacheTimestamp :: forall (m :: * -> *). Ide m => m (Maybe UTCTime)
getCacheTimestamp = do
IORef (Maybe UTCTime)
x <- IdeEnvironment -> IORef (Maybe UTCTime)
ideCacheDbTimestamp forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall r (m :: * -> *). MonadReader r m => m r
ask
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (forall a. IORef a -> IO a
readIORef IORef (Maybe UTCTime)
x)
readCacheTimestamp :: Ide m => m (Maybe UTCTime)
readCacheTimestamp :: forall (m :: * -> *). Ide m => m (Maybe UTCTime)
readCacheTimestamp = do
FilePath
cacheDb <- FilePath -> FilePath
cacheDbFile forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). Ide m => m FilePath
getOutputDirectory
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (forall (m :: * -> *) e a. Alternative m => Either e a -> m a
hush forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e a. Exception e => IO a -> IO (Either e a)
try @SomeException (FilePath -> IO UTCTime
getModificationTime FilePath
cacheDb))
updateCacheTimestamp :: Ide m => m (Maybe (Maybe UTCTime, Maybe UTCTime))
updateCacheTimestamp :: forall (m :: * -> *).
Ide m =>
m (Maybe (Maybe UTCTime, Maybe UTCTime))
updateCacheTimestamp = do
Maybe UTCTime
old <- forall (m :: * -> *). Ide m => m (Maybe UTCTime)
getCacheTimestamp
Maybe UTCTime
new <- forall (m :: * -> *). Ide m => m (Maybe UTCTime)
readCacheTimestamp
if Maybe UTCTime
old forall a. Eq a => a -> a -> Bool
== Maybe UTCTime
new
then forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
else do
IORef (Maybe UTCTime)
ts <- IdeEnvironment -> IORef (Maybe UTCTime)
ideCacheDbTimestamp forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall r (m :: * -> *). MonadReader r m => m r
ask
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (forall a. IORef a -> a -> IO ()
writeIORef IORef (Maybe UTCTime)
ts Maybe UTCTime
new)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. a -> Maybe a
Just (Maybe UTCTime
old, Maybe UTCTime
new))
getLoadedModulenames :: Ide m => m [P.ModuleName]
getLoadedModulenames :: forall (m :: * -> *). Ide m => m [ModuleName]
getLoadedModulenames = forall k a. Map k a -> [k]
Map.keys forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). Ide m => m (ModuleMap ExternsFile)
getExternFiles
getExternFiles :: Ide m => m (ModuleMap ExternsFile)
getExternFiles :: forall (m :: * -> *). Ide m => m (ModuleMap ExternsFile)
getExternFiles = IdeFileState -> ModuleMap ExternsFile
fsExterns forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). Ide m => m IdeFileState
getFileState
insertModule :: Ide m => (FilePath, P.Module) -> m ()
insertModule :: forall (m :: * -> *). Ide m => (FilePath, Module) -> m ()
insertModule (FilePath, Module)
module' = do
TVar IdeState
stateVar <- IdeEnvironment -> TVar IdeState
ideStateVar forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall r (m :: * -> *). MonadReader r m => m r
ask
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. STM a -> IO a
atomically forall a b. (a -> b) -> a -> b
$ TVar IdeState -> (FilePath, Module) -> STM ()
insertModuleSTM TVar IdeState
stateVar (FilePath, Module)
module'
insertModuleSTM :: TVar IdeState -> (FilePath, P.Module) -> STM ()
insertModuleSTM :: TVar IdeState -> (FilePath, Module) -> STM ()
insertModuleSTM TVar IdeState
ref (FilePath
fp, Module
module') =
forall a. TVar a -> (a -> a) -> STM ()
modifyTVar TVar IdeState
ref forall a b. (a -> b) -> a -> b
$ \IdeState
x ->
IdeState
x { ideFileState :: IdeFileState
ideFileState = (IdeState -> IdeFileState
ideFileState IdeState
x) {
fsModules :: ModuleMap (Module, FilePath)
fsModules = forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert
(Module -> ModuleName
P.getModuleName Module
module')
(Module
module', FilePath
fp)
(IdeFileState -> ModuleMap (Module, FilePath)
fsModules (IdeState -> IdeFileState
ideFileState IdeState
x))}}
getFileState :: Ide m => m IdeFileState
getFileState :: forall (m :: * -> *). Ide m => m IdeFileState
getFileState = do
TVar IdeState
st <- IdeEnvironment -> TVar IdeState
ideStateVar forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall r (m :: * -> *). MonadReader r m => m r
ask
IdeState -> IdeFileState
ideFileState forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (forall a. TVar a -> IO a
readTVarIO TVar IdeState
st)
getFileStateSTM :: TVar IdeState -> STM IdeFileState
getFileStateSTM :: TVar IdeState -> STM IdeFileState
getFileStateSTM TVar IdeState
ref = IdeState -> IdeFileState
ideFileState forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. TVar a -> STM a
readTVar TVar IdeState
ref
getVolatileState :: Ide m => m IdeVolatileState
getVolatileState :: forall (m :: * -> *). Ide m => m IdeVolatileState
getVolatileState = do
TVar IdeState
st <- IdeEnvironment -> TVar IdeState
ideStateVar forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall r (m :: * -> *). MonadReader r m => m r
ask
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (forall a. STM a -> IO a
atomically (TVar IdeState -> STM IdeVolatileState
getVolatileStateSTM TVar IdeState
st))
getVolatileStateSTM :: TVar IdeState -> STM IdeVolatileState
getVolatileStateSTM :: TVar IdeState -> STM IdeVolatileState
getVolatileStateSTM TVar IdeState
st = IdeState -> IdeVolatileState
ideVolatileState forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. TVar a -> STM a
readTVar TVar IdeState
st
setVolatileStateSTM :: TVar IdeState -> IdeVolatileState -> STM ()
setVolatileStateSTM :: TVar IdeState -> IdeVolatileState -> STM ()
setVolatileStateSTM TVar IdeState
ref IdeVolatileState
vs = do
forall a. TVar a -> (a -> a) -> STM ()
modifyTVar TVar IdeState
ref forall a b. (a -> b) -> a -> b
$ \IdeState
x ->
IdeState
x {ideVolatileState :: IdeVolatileState
ideVolatileState = IdeVolatileState
vs}
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
getAllModules :: Ide m => Maybe P.ModuleName -> m (ModuleMap [IdeDeclarationAnn])
getAllModules :: forall (m :: * -> *).
Ide m =>
Maybe ModuleName -> m (ModuleMap [IdeDeclarationAnn])
getAllModules Maybe ModuleName
mmoduleName = do
ModuleMap [IdeDeclarationAnn]
declarations <- IdeVolatileState -> ModuleMap [IdeDeclarationAnn]
vsDeclarations forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). Ide m => m IdeVolatileState
getVolatileState
Maybe (ModuleName, ExternsFile)
rebuild <- forall (m :: * -> *). Ide m => m (Maybe (ModuleName, ExternsFile))
cachedRebuild
case Maybe ModuleName
mmoduleName of
Maybe ModuleName
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ModuleMap [IdeDeclarationAnn]
declarations
Just ModuleName
moduleName ->
case Maybe (ModuleName, ExternsFile)
rebuild of
Just (ModuleName
cachedModulename, ExternsFile
ef)
| ModuleName
cachedModulename forall a. Eq a => a -> a -> Bool
== ModuleName
moduleName -> do
AstData ModuleMap (DefinitionSites SourceSpan, TypeAnnotations)
asts <- IdeVolatileState -> AstData SourceSpan
vsAstData forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). Ide m => m IdeVolatileState
getVolatileState
let
ast :: (DefinitionSites SourceSpan, TypeAnnotations)
ast =
forall a. a -> Maybe a -> a
fromMaybe (forall k a. Map k a
Map.empty, forall k a. Map k a
Map.empty) (forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup ModuleName
moduleName ModuleMap (DefinitionSites SourceSpan, TypeAnnotations)
asts)
cachedModule :: [IdeDeclarationAnn]
cachedModule =
(DefinitionSites SourceSpan, TypeAnnotations)
-> [IdeDeclarationAnn] -> [IdeDeclarationAnn]
resolveLocationsForModule (DefinitionSites SourceSpan, TypeAnnotations)
ast (forall a b. (a, b) -> a
fst (ExternsFile
-> ([IdeDeclarationAnn], [(ModuleName, DeclarationRef)])
convertExterns ExternsFile
ef))
tmp :: ModuleMap [IdeDeclarationAnn]
tmp =
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert ModuleName
moduleName [IdeDeclarationAnn]
cachedModule ModuleMap [IdeDeclarationAnn]
declarations
resolved :: ModuleMap [IdeDeclarationAnn]
resolved =
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust (ModuleMap [IdeDeclarationAnn]
-> [IdeDeclarationAnn] -> [IdeDeclarationAnn]
resolveOperatorsForModule ModuleMap [IdeDeclarationAnn]
tmp) ModuleName
moduleName ModuleMap [IdeDeclarationAnn]
tmp
forall (f :: * -> *) a. Applicative f => a -> f a
pure ModuleMap [IdeDeclarationAnn]
resolved
Maybe (ModuleName, ExternsFile)
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ModuleMap [IdeDeclarationAnn]
declarations
insertExterns :: Ide m => ExternsFile -> m ()
insertExterns :: forall (m :: * -> *). Ide m => ExternsFile -> m ()
insertExterns ExternsFile
ef = do
TVar IdeState
st <- IdeEnvironment -> TVar IdeState
ideStateVar forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall r (m :: * -> *). MonadReader r m => m r
ask
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (forall a. STM a -> IO a
atomically (TVar IdeState -> ExternsFile -> STM ()
insertExternsSTM TVar IdeState
st ExternsFile
ef))
insertExternsSTM :: TVar IdeState -> ExternsFile -> STM ()
insertExternsSTM :: TVar IdeState -> ExternsFile -> STM ()
insertExternsSTM TVar IdeState
ref ExternsFile
ef =
forall a. TVar a -> (a -> a) -> STM ()
modifyTVar TVar IdeState
ref forall a b. (a -> b) -> a -> b
$ \IdeState
x ->
IdeState
x { ideFileState :: IdeFileState
ideFileState = (IdeState -> IdeFileState
ideFileState IdeState
x) {
fsExterns :: ModuleMap ExternsFile
fsExterns = forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (ExternsFile -> ModuleName
efModuleName ExternsFile
ef) ExternsFile
ef (IdeFileState -> ModuleMap ExternsFile
fsExterns (IdeState -> IdeFileState
ideFileState IdeState
x))}}
cacheRebuild :: Ide m => ExternsFile -> m ()
cacheRebuild :: forall (m :: * -> *). Ide m => ExternsFile -> m ()
cacheRebuild ExternsFile
ef = do
TVar IdeState
st <- IdeEnvironment -> TVar IdeState
ideStateVar forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall r (m :: * -> *). MonadReader r m => m r
ask
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. STM a -> IO a
atomically forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. TVar a -> (a -> a) -> STM ()
modifyTVar TVar IdeState
st forall a b. (a -> b) -> a -> b
$ \IdeState
x ->
IdeState
x { ideVolatileState :: IdeVolatileState
ideVolatileState = (IdeState -> IdeVolatileState
ideVolatileState IdeState
x) {
vsCachedRebuild :: Maybe (ModuleName, ExternsFile)
vsCachedRebuild = forall a. a -> Maybe a
Just (ExternsFile -> ModuleName
efModuleName ExternsFile
ef, ExternsFile
ef)}}
cachedRebuild :: Ide m => m (Maybe (P.ModuleName, ExternsFile))
cachedRebuild :: forall (m :: * -> *). Ide m => m (Maybe (ModuleName, ExternsFile))
cachedRebuild = IdeVolatileState -> Maybe (ModuleName, ExternsFile)
vsCachedRebuild forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). Ide m => m IdeVolatileState
getVolatileState
populateVolatileStateSync :: (Ide m, MonadLogger m) => m ()
populateVolatileStateSync :: forall (m :: * -> *). (Ide m, MonadLogger m) => m ()
populateVolatileStateSync = do
TVar IdeState
st <- IdeEnvironment -> TVar IdeState
ideStateVar forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall r (m :: * -> *). MonadReader r m => m r
ask
let message :: TimeSpec -> Text
message TimeSpec
duration = Text
"Finished populating volatile state in: " forall a. Semigroup a => a -> a -> a
<> TimeSpec -> Text
displayTimeSpec TimeSpec
duration
ModuleMap (ReexportResult [IdeDeclarationAnn])
results <- forall (m :: * -> *) t.
(MonadIO m, MonadLogger m) =>
(TimeSpec -> Text) -> m t -> m t
logPerf TimeSpec -> Text
message forall a b. (a -> b) -> a -> b
$ do
!ModuleMap (ReexportResult [IdeDeclarationAnn])
r <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (forall a. STM a -> IO a
atomically (TVar IdeState
-> STM (ModuleMap (ReexportResult [IdeDeclarationAnn]))
populateVolatileStateSTM TVar IdeState
st))
forall (f :: * -> *) a. Applicative f => a -> f a
pure ModuleMap (ReexportResult [IdeDeclarationAnn])
r
forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) k a b.
Applicative t =>
(k -> a -> t b) -> Map k a -> t (Map k b)
Map.traverseWithKey
(\ModuleName
mn -> forall (m :: * -> *). MonadLogger m => Text -> m ()
logWarnN forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Text) -> ReexportResult a -> Text
prettyPrintReexportResult (forall a b. a -> b -> a
const (ModuleName -> Text
P.runModuleName ModuleName
mn)))
(forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter forall a. ReexportResult a -> Bool
reexportHasFailures ModuleMap (ReexportResult [IdeDeclarationAnn])
results)
populateVolatileState :: Ide m => m (Async ())
populateVolatileState :: forall (m :: * -> *). Ide m => m (Async ())
populateVolatileState = do
IdeEnvironment
env <- forall r (m :: * -> *). MonadReader r m => m r
ask
let ll :: IdeLogLevel
ll = IdeConfiguration -> IdeLogLevel
confLogLevel (IdeEnvironment -> IdeConfiguration
ideConfiguration IdeEnvironment
env)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (forall a. IO a -> IO (Async a)
async (forall (m :: * -> *) a.
MonadIO m =>
IdeLogLevel -> LoggingT m a -> m a
runLogger IdeLogLevel
ll (forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT forall (m :: * -> *). (Ide m, MonadLogger m) => m ()
populateVolatileStateSync IdeEnvironment
env)))
populateVolatileStateSTM
:: TVar IdeState
-> STM (ModuleMap (ReexportResult [IdeDeclarationAnn]))
populateVolatileStateSTM :: TVar IdeState
-> STM (ModuleMap (ReexportResult [IdeDeclarationAnn]))
populateVolatileStateSTM TVar IdeState
ref = do
IdeFileState{fsExterns :: IdeFileState -> ModuleMap ExternsFile
fsExterns = ModuleMap ExternsFile
externs, fsModules :: IdeFileState -> ModuleMap (Module, FilePath)
fsModules = ModuleMap (Module, FilePath)
modules} <- TVar IdeState -> STM IdeFileState
getFileStateSTM TVar IdeState
ref
Maybe (ModuleName, ExternsFile)
rebuildCache <- IdeVolatileState -> Maybe (ModuleName, ExternsFile)
vsCachedRebuild forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TVar IdeState -> STM IdeVolatileState
getVolatileStateSTM TVar IdeState
ref
let asts :: ModuleMap (DefinitionSites SourceSpan, TypeAnnotations)
asts = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (Module -> (DefinitionSites SourceSpan, TypeAnnotations)
extractAstInformation forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) ModuleMap (Module, FilePath)
modules
let (ModuleMap [IdeDeclarationAnn]
moduleDeclarations, Map ModuleName [(ModuleName, DeclarationRef)]
reexportRefs) = forall (f :: * -> *) a b. Unzip f => f (a, b) -> (f a, f b)
unzip (forall a b k. (a -> b) -> Map k a -> Map k b
Map.map ExternsFile
-> ([IdeDeclarationAnn], [(ModuleName, DeclarationRef)])
convertExterns ModuleMap ExternsFile
externs)
results :: ModuleMap (ReexportResult [IdeDeclarationAnn])
results =
ModuleMap [IdeDeclarationAnn]
moduleDeclarations
forall a b. a -> (a -> b) -> b
& forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map [IdeDeclarationAnn] -> [IdeDeclarationAnn]
resolveDataConstructorsForModule
forall a b. a -> (a -> b) -> b
& ModuleMap (DefinitionSites SourceSpan, TypeAnnotations)
-> ModuleMap [IdeDeclarationAnn] -> ModuleMap [IdeDeclarationAnn]
resolveLocations ModuleMap (DefinitionSites SourceSpan, TypeAnnotations)
asts
forall a b. a -> (a -> b) -> b
& ModuleMap Module
-> ModuleMap [IdeDeclarationAnn] -> ModuleMap [IdeDeclarationAnn]
resolveDocumentation (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map forall a b. (a, b) -> a
fst ModuleMap (Module, FilePath)
modules)
forall a b. a -> (a -> b) -> b
& ModuleMap ExternsFile
-> ModuleMap [IdeDeclarationAnn] -> ModuleMap [IdeDeclarationAnn]
resolveInstances ModuleMap ExternsFile
externs
forall a b. a -> (a -> b) -> b
& ModuleMap [IdeDeclarationAnn] -> ModuleMap [IdeDeclarationAnn]
resolveOperators
forall a b. a -> (a -> b) -> b
& Map ModuleName [(ModuleName, DeclarationRef)]
-> ModuleMap [IdeDeclarationAnn]
-> ModuleMap (ReexportResult [IdeDeclarationAnn])
resolveReexports Map ModuleName [(ModuleName, DeclarationRef)]
reexportRefs
TVar IdeState -> IdeVolatileState -> STM ()
setVolatileStateSTM TVar IdeState
ref (AstData SourceSpan
-> ModuleMap [IdeDeclarationAnn]
-> Maybe (ModuleName, ExternsFile)
-> IdeVolatileState
IdeVolatileState (forall a.
ModuleMap (DefinitionSites a, TypeAnnotations) -> AstData a
AstData ModuleMap (DefinitionSites SourceSpan, TypeAnnotations)
asts) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map forall a. ReexportResult a -> a
reResolved ModuleMap (ReexportResult [IdeDeclarationAnn])
results) Maybe (ModuleName, ExternsFile)
rebuildCache)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. NFData a => a -> a
force ModuleMap (ReexportResult [IdeDeclarationAnn])
results)
resolveLocations
:: ModuleMap (DefinitionSites P.SourceSpan, TypeAnnotations)
-> ModuleMap [IdeDeclarationAnn]
-> ModuleMap [IdeDeclarationAnn]
resolveLocations :: ModuleMap (DefinitionSites SourceSpan, TypeAnnotations)
-> ModuleMap [IdeDeclarationAnn] -> ModuleMap [IdeDeclarationAnn]
resolveLocations ModuleMap (DefinitionSites SourceSpan, TypeAnnotations)
asts =
forall k a b. (k -> a -> b) -> Map k a -> Map k b
Map.mapWithKey (\ModuleName
mn [IdeDeclarationAnn]
decls ->
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [IdeDeclarationAnn]
decls (forall a b c. (a -> b -> c) -> b -> a -> c
flip (DefinitionSites SourceSpan, TypeAnnotations)
-> [IdeDeclarationAnn] -> [IdeDeclarationAnn]
resolveLocationsForModule [IdeDeclarationAnn]
decls) (forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup ModuleName
mn ModuleMap (DefinitionSites SourceSpan, TypeAnnotations)
asts))
resolveLocationsForModule
:: (DefinitionSites P.SourceSpan, TypeAnnotations)
-> [IdeDeclarationAnn]
-> [IdeDeclarationAnn]
resolveLocationsForModule :: (DefinitionSites SourceSpan, TypeAnnotations)
-> [IdeDeclarationAnn] -> [IdeDeclarationAnn]
resolveLocationsForModule (DefinitionSites SourceSpan
defs, TypeAnnotations
types) =
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map IdeDeclarationAnn -> IdeDeclarationAnn
convertDeclaration
where
convertDeclaration :: IdeDeclarationAnn -> IdeDeclarationAnn
convertDeclaration :: IdeDeclarationAnn -> IdeDeclarationAnn
convertDeclaration (IdeDeclarationAnn Annotation
ann IdeDeclaration
d) = (Ident -> IdeDeclaration -> IdeDeclarationAnn)
-> (Text -> IdeDeclaration -> IdeDeclarationAnn)
-> (Text -> IdeDeclaration -> IdeDeclarationAnn)
-> (Text -> IdeDeclaration -> IdeDeclarationAnn)
-> (Text -> IdeDeclaration -> IdeDeclarationAnn)
-> (Text -> IdeDeclaration -> IdeDeclarationAnn)
-> IdeDeclaration
-> IdeDeclarationAnn
convertDeclaration'
Ident -> IdeDeclaration -> IdeDeclarationAnn
annotateFunction
Text -> IdeDeclaration -> IdeDeclarationAnn
annotateValue
Text -> IdeDeclaration -> IdeDeclarationAnn
annotateDataConstructor
Text -> IdeDeclaration -> IdeDeclarationAnn
annotateType
Text -> IdeDeclaration -> IdeDeclarationAnn
annotateType
Text -> IdeDeclaration -> IdeDeclarationAnn
annotateModule
IdeDeclaration
d
where
annotateFunction :: Ident -> IdeDeclaration -> IdeDeclarationAnn
annotateFunction Ident
x = Annotation -> IdeDeclaration -> IdeDeclarationAnn
IdeDeclarationAnn (Annotation
ann { _annLocation :: Maybe SourceSpan
_annLocation = forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (IdeNamespace -> Text -> IdeNamespaced
IdeNamespaced IdeNamespace
IdeNSValue (Ident -> Text
P.runIdent Ident
x)) DefinitionSites SourceSpan
defs
, _annTypeAnnotation :: Maybe SourceType
_annTypeAnnotation = forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Ident
x TypeAnnotations
types
})
annotateValue :: Text -> IdeDeclaration -> IdeDeclarationAnn
annotateValue Text
x = Annotation -> IdeDeclaration -> IdeDeclarationAnn
IdeDeclarationAnn (Annotation
ann {_annLocation :: Maybe SourceSpan
_annLocation = forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (IdeNamespace -> Text -> IdeNamespaced
IdeNamespaced IdeNamespace
IdeNSValue Text
x) DefinitionSites SourceSpan
defs})
annotateDataConstructor :: Text -> IdeDeclaration -> IdeDeclarationAnn
annotateDataConstructor Text
x = Annotation -> IdeDeclaration -> IdeDeclarationAnn
IdeDeclarationAnn (Annotation
ann {_annLocation :: Maybe SourceSpan
_annLocation = forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (IdeNamespace -> Text -> IdeNamespaced
IdeNamespaced IdeNamespace
IdeNSValue Text
x) DefinitionSites SourceSpan
defs})
annotateType :: Text -> IdeDeclaration -> IdeDeclarationAnn
annotateType Text
x = Annotation -> IdeDeclaration -> IdeDeclarationAnn
IdeDeclarationAnn (Annotation
ann {_annLocation :: Maybe SourceSpan
_annLocation = forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (IdeNamespace -> Text -> IdeNamespaced
IdeNamespaced IdeNamespace
IdeNSType Text
x) DefinitionSites SourceSpan
defs})
annotateModule :: Text -> IdeDeclaration -> IdeDeclarationAnn
annotateModule Text
x = Annotation -> IdeDeclaration -> IdeDeclarationAnn
IdeDeclarationAnn (Annotation
ann {_annLocation :: Maybe SourceSpan
_annLocation = forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (IdeNamespace -> Text -> IdeNamespaced
IdeNamespaced IdeNamespace
IdeNSModule Text
x) DefinitionSites SourceSpan
defs})
convertDeclaration'
:: (P.Ident -> IdeDeclaration -> IdeDeclarationAnn)
-> (Text -> IdeDeclaration -> IdeDeclarationAnn)
-> (Text -> IdeDeclaration -> IdeDeclarationAnn)
-> (Text -> IdeDeclaration -> IdeDeclarationAnn)
-> (Text -> IdeDeclaration -> IdeDeclarationAnn)
-> (Text -> IdeDeclaration -> IdeDeclarationAnn)
-> IdeDeclaration
-> IdeDeclarationAnn
convertDeclaration' :: (Ident -> IdeDeclaration -> IdeDeclarationAnn)
-> (Text -> IdeDeclaration -> IdeDeclarationAnn)
-> (Text -> IdeDeclaration -> IdeDeclarationAnn)
-> (Text -> IdeDeclaration -> IdeDeclarationAnn)
-> (Text -> IdeDeclaration -> IdeDeclarationAnn)
-> (Text -> IdeDeclaration -> IdeDeclarationAnn)
-> IdeDeclaration
-> IdeDeclarationAnn
convertDeclaration' Ident -> IdeDeclaration -> IdeDeclarationAnn
annotateFunction Text -> IdeDeclaration -> IdeDeclarationAnn
annotateValue Text -> IdeDeclaration -> IdeDeclarationAnn
annotateDataConstructor Text -> IdeDeclaration -> IdeDeclarationAnn
annotateType Text -> IdeDeclaration -> IdeDeclarationAnn
annotateClass Text -> IdeDeclaration -> IdeDeclarationAnn
annotateModule IdeDeclaration
d =
case IdeDeclaration
d of
IdeDeclValue IdeValue
v ->
Ident -> IdeDeclaration -> IdeDeclarationAnn
annotateFunction (IdeValue
v forall s a. s -> Getting a s a -> a
^. Lens' IdeValue Ident
ideValueIdent) IdeDeclaration
d
IdeDeclType IdeType
t ->
Text -> IdeDeclaration -> IdeDeclarationAnn
annotateType (IdeType
t forall s a. s -> Getting a s a -> a
^. Lens' IdeType (ProperName 'TypeName)
ideTypeName forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall r (a :: ProperNameType). Getting r (ProperName a) Text
properNameT) IdeDeclaration
d
IdeDeclTypeSynonym IdeTypeSynonym
s ->
Text -> IdeDeclaration -> IdeDeclarationAnn
annotateType (IdeTypeSynonym
s forall s a. s -> Getting a s a -> a
^. Lens' IdeTypeSynonym (ProperName 'TypeName)
ideSynonymName forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall r (a :: ProperNameType). Getting r (ProperName a) Text
properNameT) IdeDeclaration
d
IdeDeclDataConstructor IdeDataConstructor
dtor ->
Text -> IdeDeclaration -> IdeDeclarationAnn
annotateDataConstructor (IdeDataConstructor
dtor forall s a. s -> Getting a s a -> a
^. Lens' IdeDataConstructor (ProperName 'ConstructorName)
ideDtorName forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall r (a :: ProperNameType). Getting r (ProperName a) Text
properNameT) IdeDeclaration
d
IdeDeclTypeClass IdeTypeClass
tc ->
Text -> IdeDeclaration -> IdeDeclarationAnn
annotateClass (IdeTypeClass
tc forall s a. s -> Getting a s a -> a
^. Lens' IdeTypeClass (ProperName 'ClassName)
ideTCName forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall r (a :: ProperNameType). Getting r (ProperName a) Text
properNameT) IdeDeclaration
d
IdeDeclValueOperator IdeValueOperator
operator ->
Text -> IdeDeclaration -> IdeDeclarationAnn
annotateValue (IdeValueOperator
operator forall s a. s -> Getting a s a -> a
^. Lens' IdeValueOperator (OpName 'ValueOpName)
ideValueOpName forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall r (a :: OpNameType). Getting r (OpName a) Text
opNameT) IdeDeclaration
d
IdeDeclTypeOperator IdeTypeOperator
operator ->
Text -> IdeDeclaration -> IdeDeclarationAnn
annotateType (IdeTypeOperator
operator forall s a. s -> Getting a s a -> a
^. Lens' IdeTypeOperator (OpName 'TypeOpName)
ideTypeOpName forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall r (a :: OpNameType). Getting r (OpName a) Text
opNameT) IdeDeclaration
d
IdeDeclModule ModuleName
mn ->
Text -> IdeDeclaration -> IdeDeclarationAnn
annotateModule (ModuleName -> Text
P.runModuleName ModuleName
mn) IdeDeclaration
d
resolveDocumentation
:: ModuleMap P.Module
-> ModuleMap [IdeDeclarationAnn]
-> ModuleMap [IdeDeclarationAnn]
resolveDocumentation :: ModuleMap Module
-> ModuleMap [IdeDeclarationAnn] -> ModuleMap [IdeDeclarationAnn]
resolveDocumentation ModuleMap Module
modules =
forall k a b. (k -> a -> b) -> Map k a -> Map k b
Map.mapWithKey (\ModuleName
mn [IdeDeclarationAnn]
decls ->
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [IdeDeclarationAnn]
decls (forall a b c. (a -> b -> c) -> b -> a -> c
flip Module -> [IdeDeclarationAnn] -> [IdeDeclarationAnn]
resolveDocumentationForModule [IdeDeclarationAnn]
decls) (forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup ModuleName
mn ModuleMap Module
modules))
resolveDocumentationForModule
:: P.Module
-> [IdeDeclarationAnn]
-> [IdeDeclarationAnn]
resolveDocumentationForModule :: Module -> [IdeDeclarationAnn] -> [IdeDeclarationAnn]
resolveDocumentationForModule (P.Module SourceSpan
_ [Comment]
moduleComments ModuleName
moduleName [Declaration]
sdecls Maybe [DeclarationRef]
_) =
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map IdeDeclarationAnn -> IdeDeclarationAnn
convertDecl
where
extractDeclComments :: P.Declaration -> [(P.Name, [P.Comment])]
extractDeclComments :: Declaration -> [(Name, [Comment])]
extractDeclComments = \case
P.DataDeclaration (SourceSpan
_, [Comment]
cs) DataDeclType
_ ProperName 'TypeName
ctorName [(Text, Maybe SourceType)]
_ [DataConstructorDeclaration]
ctors ->
(ProperName 'TypeName -> Name
P.TyName ProperName 'TypeName
ctorName, [Comment]
cs) forall a. a -> [a] -> [a]
: forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map DataConstructorDeclaration -> (Name, [Comment])
dtorComments [DataConstructorDeclaration]
ctors
P.TypeClassDeclaration (SourceSpan
_, [Comment]
cs) ProperName 'ClassName
tyClassName [(Text, Maybe SourceType)]
_ [SourceConstraint]
_ [FunctionalDependency]
_ [Declaration]
members ->
(ProperName 'ClassName -> Name
P.TyClassName ProperName 'ClassName
tyClassName, [Comment]
cs) forall a. a -> [a] -> [a]
: forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Declaration -> [(Name, [Comment])]
extractDeclComments [Declaration]
members
Declaration
decl ->
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\Name
name' -> [(Name
name', forall a b. (a, b) -> b
snd (Declaration -> (SourceSpan, [Comment])
P.declSourceAnn Declaration
decl))]) (Declaration -> Maybe Name
name Declaration
decl)
comments :: Map P.Name [P.Comment]
comments :: Map Name [Comment]
comments = forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (ModuleName -> Name
P.ModName ModuleName
moduleName) [Comment]
moduleComments forall a b. (a -> b) -> a -> b
$
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. Semigroup a => a -> a -> a
(<>)) forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Declaration -> [(Name, [Comment])]
extractDeclComments [Declaration]
sdecls
dtorComments :: P.DataConstructorDeclaration -> (P.Name, [P.Comment])
dtorComments :: DataConstructorDeclaration -> (Name, [Comment])
dtorComments DataConstructorDeclaration
dcd = (ProperName 'ConstructorName -> Name
P.DctorName (DataConstructorDeclaration -> ProperName 'ConstructorName
P.dataCtorName DataConstructorDeclaration
dcd), forall a b. (a, b) -> b
snd (DataConstructorDeclaration -> (SourceSpan, [Comment])
P.dataCtorAnn DataConstructorDeclaration
dcd))
name :: P.Declaration -> Maybe P.Name
name :: Declaration -> Maybe Name
name (P.TypeDeclaration TypeDeclarationData
d) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Ident -> Name
P.IdentName forall a b. (a -> b) -> a -> b
$ TypeDeclarationData -> Ident
P.tydeclIdent TypeDeclarationData
d
name Declaration
decl = Declaration -> Maybe Name
P.declName Declaration
decl
convertDecl :: IdeDeclarationAnn -> IdeDeclarationAnn
convertDecl :: IdeDeclarationAnn -> IdeDeclarationAnn
convertDecl (IdeDeclarationAnn Annotation
ann IdeDeclaration
d) =
(Ident -> IdeDeclaration -> IdeDeclarationAnn)
-> (Text -> IdeDeclaration -> IdeDeclarationAnn)
-> (Text -> IdeDeclaration -> IdeDeclarationAnn)
-> (Text -> IdeDeclaration -> IdeDeclarationAnn)
-> (Text -> IdeDeclaration -> IdeDeclarationAnn)
-> (Text -> IdeDeclaration -> IdeDeclarationAnn)
-> IdeDeclaration
-> IdeDeclarationAnn
convertDeclaration'
(Name -> IdeDeclaration -> IdeDeclarationAnn
annotateValue forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ident -> Name
P.IdentName)
(Name -> IdeDeclaration -> IdeDeclarationAnn
annotateValue forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ident -> Name
P.IdentName forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Ident
P.Ident)
(Name -> IdeDeclaration -> IdeDeclarationAnn
annotateValue forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProperName 'ConstructorName -> Name
P.DctorName forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (a :: ProperNameType). Text -> ProperName a
P.ProperName)
(Name -> IdeDeclaration -> IdeDeclarationAnn
annotateValue forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProperName 'TypeName -> Name
P.TyName forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (a :: ProperNameType). Text -> ProperName a
P.ProperName)
(Name -> IdeDeclaration -> IdeDeclarationAnn
annotateValue forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProperName 'ClassName -> Name
P.TyClassName forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (a :: ProperNameType). Text -> ProperName a
P.ProperName)
(Name -> IdeDeclaration -> IdeDeclarationAnn
annotateValue forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModuleName -> Name
P.ModName forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ModuleName
P.moduleNameFromString)
IdeDeclaration
d
where
docs :: P.Name -> Text
docs :: Name -> Text
docs Name
ident = forall a. a -> Maybe a -> a
fromMaybe Text
"" forall a b. (a -> b) -> a -> b
$ [Comment] -> Maybe Text
convertComments forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Name
ident Map Name [Comment]
comments
annotateValue :: Name -> IdeDeclaration -> IdeDeclarationAnn
annotateValue Name
ident = Annotation -> IdeDeclaration -> IdeDeclarationAnn
IdeDeclarationAnn (Annotation
ann { _annDocumentation :: Maybe Text
_annDocumentation = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Name -> Text
docs Name
ident })
resolveInstances
:: ModuleMap P.ExternsFile
-> ModuleMap [IdeDeclarationAnn]
-> ModuleMap [IdeDeclarationAnn]
resolveInstances :: ModuleMap ExternsFile
-> ModuleMap [IdeDeclarationAnn] -> ModuleMap [IdeDeclarationAnn]
resolveInstances ModuleMap ExternsFile
externs ModuleMap [IdeDeclarationAnn]
declarations =
forall a b k. (a -> b -> b) -> b -> Map k a -> b
Map.foldr (forall a b c. (a -> b -> c) -> b -> a -> c
flip (forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (IdeInstance, ModuleName, ProperName 'ClassName)
-> ModuleMap [IdeDeclarationAnn] -> ModuleMap [IdeDeclarationAnn]
go)) ModuleMap [IdeDeclarationAnn]
declarations
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a b. (k -> a -> b) -> Map k a -> Map k b
Map.mapWithKey (\ModuleName
mn ExternsFile
ef -> forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (ModuleName
-> ExternsDeclaration
-> Maybe (IdeInstance, ModuleName, ProperName 'ClassName)
extractInstances ModuleName
mn) (ExternsFile -> [ExternsDeclaration]
efDeclarations ExternsFile
ef))
forall a b. (a -> b) -> a -> b
$ ModuleMap ExternsFile
externs
where
extractInstances :: ModuleName
-> ExternsDeclaration
-> Maybe (IdeInstance, ModuleName, ProperName 'ClassName)
extractInstances ModuleName
mn P.EDInstance{Integer
[(Text, SourceType)]
[SourceType]
Maybe [SourceConstraint]
Maybe ChainId
SourceSpan
Qualified (ProperName 'ClassName)
Ident
NameSource
edInstanceSourceSpan :: ExternsDeclaration -> SourceSpan
edInstanceNameSource :: ExternsDeclaration -> NameSource
edInstanceChainIndex :: ExternsDeclaration -> Integer
edInstanceChain :: ExternsDeclaration -> Maybe ChainId
edInstanceConstraints :: ExternsDeclaration -> Maybe [SourceConstraint]
edInstanceTypes :: ExternsDeclaration -> [SourceType]
edInstanceKinds :: ExternsDeclaration -> [SourceType]
edInstanceForAll :: ExternsDeclaration -> [(Text, SourceType)]
edInstanceName :: ExternsDeclaration -> Ident
edInstanceClassName :: ExternsDeclaration -> Qualified (ProperName 'ClassName)
edInstanceSourceSpan :: SourceSpan
edInstanceNameSource :: NameSource
edInstanceChainIndex :: Integer
edInstanceChain :: Maybe ChainId
edInstanceConstraints :: Maybe [SourceConstraint]
edInstanceTypes :: [SourceType]
edInstanceKinds :: [SourceType]
edInstanceForAll :: [(Text, SourceType)]
edInstanceName :: Ident
edInstanceClassName :: Qualified (ProperName 'ClassName)
..} =
case Qualified (ProperName 'ClassName)
edInstanceClassName of
P.Qualified (P.ByModuleName ModuleName
classModule) ProperName 'ClassName
className ->
forall a. a -> Maybe a
Just (ModuleName
-> Ident -> [SourceType] -> Maybe [SourceConstraint] -> IdeInstance
IdeInstance ModuleName
mn
Ident
edInstanceName
[SourceType]
edInstanceTypes
Maybe [SourceConstraint]
edInstanceConstraints, ModuleName
classModule, ProperName 'ClassName
className)
Qualified (ProperName 'ClassName)
_ -> forall a. Maybe a
Nothing
extractInstances ModuleName
_ ExternsDeclaration
_ = forall a. Maybe a
Nothing
go
:: (IdeInstance, P.ModuleName, P.ProperName 'P.ClassName)
-> ModuleMap [IdeDeclarationAnn]
-> ModuleMap [IdeDeclarationAnn]
go :: (IdeInstance, ModuleName, ProperName 'ClassName)
-> ModuleMap [IdeDeclarationAnn] -> ModuleMap [IdeDeclarationAnn]
go (IdeInstance
ideInstance, ModuleName
classModule, ProperName 'ClassName
className) ModuleMap [IdeDeclarationAnn]
acc' =
let
matchTC :: IdeDeclarationAnn -> Bool
matchTC =
forall s a. Getting Any s a -> (a -> Bool) -> s -> Bool
anyOf (Lens' IdeDeclarationAnn IdeDeclaration
idaDeclaration forall b c a. (b -> c) -> (a -> b) -> a -> c
. Traversal' IdeDeclaration IdeTypeClass
_IdeDeclTypeClass forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' IdeTypeClass (ProperName 'ClassName)
ideTCName) (forall a. Eq a => a -> a -> Bool
== ProperName 'ClassName
className)
updateDeclaration :: [IdeDeclarationAnn] -> [IdeDeclarationAnn]
updateDeclaration =
forall (f :: * -> *) b.
Functor f =>
(b -> Bool) -> (b -> b) -> f b -> f b
mapIf IdeDeclarationAnn -> Bool
matchTC (Lens' IdeDeclarationAnn IdeDeclaration
idaDeclaration
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Traversal' IdeDeclaration IdeTypeClass
_IdeDeclTypeClass
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' IdeTypeClass [IdeInstance]
ideTCInstances
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (IdeInstance
ideInstance forall a. a -> [a] -> [a]
:))
in
ModuleMap [IdeDeclarationAnn]
acc' forall a b. a -> (a -> b) -> b
& forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix ModuleName
classModule forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ [IdeDeclarationAnn] -> [IdeDeclarationAnn]
updateDeclaration
resolveOperators
:: ModuleMap [IdeDeclarationAnn]
-> ModuleMap [IdeDeclarationAnn]
resolveOperators :: ModuleMap [IdeDeclarationAnn] -> ModuleMap [IdeDeclarationAnn]
resolveOperators ModuleMap [IdeDeclarationAnn]
modules =
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (ModuleMap [IdeDeclarationAnn]
-> [IdeDeclarationAnn] -> [IdeDeclarationAnn]
resolveOperatorsForModule ModuleMap [IdeDeclarationAnn]
modules) ModuleMap [IdeDeclarationAnn]
modules
resolveOperatorsForModule
:: ModuleMap [IdeDeclarationAnn]
-> [IdeDeclarationAnn]
-> [IdeDeclarationAnn]
resolveOperatorsForModule :: ModuleMap [IdeDeclarationAnn]
-> [IdeDeclarationAnn] -> [IdeDeclarationAnn]
resolveOperatorsForModule ModuleMap [IdeDeclarationAnn]
modules = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (Lens' IdeDeclarationAnn IdeDeclaration
idaDeclaration forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ IdeDeclaration -> IdeDeclaration
resolveOperator)
where
getDeclarations :: P.ModuleName -> [IdeDeclaration]
getDeclarations :: ModuleName -> [IdeDeclaration]
getDeclarations ModuleName
moduleName =
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup ModuleName
moduleName ModuleMap [IdeDeclarationAnn]
modules
forall a b. a -> (a -> b) -> b
& forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map IdeDeclarationAnn -> IdeDeclaration
discardAnn)
resolveOperator :: IdeDeclaration -> IdeDeclaration
resolveOperator (IdeDeclValueOperator IdeValueOperator
op)
| (P.Qualified (P.ByModuleName ModuleName
mn) (Left Ident
ident)) <- IdeValueOperator
op forall s a. s -> Getting a s a -> a
^. Lens'
IdeValueOperator
(Qualified (Either Ident (ProperName 'ConstructorName)))
ideValueOpAlias =
let t :: Maybe SourceType
t = ModuleName -> [IdeDeclaration]
getDeclarations ModuleName
mn
forall a b. a -> (a -> b) -> b
& forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview Traversal' IdeDeclaration IdeValue
_IdeDeclValue)
forall a b. a -> (a -> b) -> b
& forall a. (a -> Bool) -> [a] -> [a]
filter (forall s a. Getting Any s a -> (a -> Bool) -> s -> Bool
anyOf Lens' IdeValue Ident
ideValueIdent (forall a. Eq a => a -> a -> Bool
== Ident
ident))
forall a b. a -> (a -> b) -> b
& forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' IdeValue SourceType
ideValueType)
forall a b. a -> (a -> b) -> b
& forall a. [a] -> Maybe a
listToMaybe
in IdeValueOperator -> IdeDeclaration
IdeDeclValueOperator (IdeValueOperator
op forall a b. a -> (a -> b) -> b
& Lens' IdeValueOperator (Maybe SourceType)
ideValueOpType forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe SourceType
t)
| (P.Qualified (P.ByModuleName ModuleName
mn) (Right ProperName 'ConstructorName
dtor)) <- IdeValueOperator
op forall s a. s -> Getting a s a -> a
^. Lens'
IdeValueOperator
(Qualified (Either Ident (ProperName 'ConstructorName)))
ideValueOpAlias =
let t :: Maybe SourceType
t = ModuleName -> [IdeDeclaration]
getDeclarations ModuleName
mn
forall a b. a -> (a -> b) -> b
& forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview Traversal' IdeDeclaration IdeDataConstructor
_IdeDeclDataConstructor)
forall a b. a -> (a -> b) -> b
& forall a. (a -> Bool) -> [a] -> [a]
filter (forall s a. Getting Any s a -> (a -> Bool) -> s -> Bool
anyOf Lens' IdeDataConstructor (ProperName 'ConstructorName)
ideDtorName (forall a. Eq a => a -> a -> Bool
== ProperName 'ConstructorName
dtor))
forall a b. a -> (a -> b) -> b
& forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' IdeDataConstructor SourceType
ideDtorType)
forall a b. a -> (a -> b) -> b
& forall a. [a] -> Maybe a
listToMaybe
in IdeValueOperator -> IdeDeclaration
IdeDeclValueOperator (IdeValueOperator
op forall a b. a -> (a -> b) -> b
& Lens' IdeValueOperator (Maybe SourceType)
ideValueOpType forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe SourceType
t)
resolveOperator (IdeDeclTypeOperator IdeTypeOperator
op)
| P.Qualified (P.ByModuleName ModuleName
mn) ProperName 'TypeName
properName <- IdeTypeOperator
op forall s a. s -> Getting a s a -> a
^. Lens' IdeTypeOperator (Qualified (ProperName 'TypeName))
ideTypeOpAlias =
let k :: Maybe SourceType
k = ModuleName -> [IdeDeclaration]
getDeclarations ModuleName
mn
forall a b. a -> (a -> b) -> b
& forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview Traversal' IdeDeclaration IdeType
_IdeDeclType)
forall a b. a -> (a -> b) -> b
& forall a. (a -> Bool) -> [a] -> [a]
filter (forall s a. Getting Any s a -> (a -> Bool) -> s -> Bool
anyOf Lens' IdeType (ProperName 'TypeName)
ideTypeName (forall a. Eq a => a -> a -> Bool
== ProperName 'TypeName
properName))
forall a b. a -> (a -> b) -> b
& forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' IdeType SourceType
ideTypeKind)
forall a b. a -> (a -> b) -> b
& forall a. [a] -> Maybe a
listToMaybe
in IdeTypeOperator -> IdeDeclaration
IdeDeclTypeOperator (IdeTypeOperator
op forall a b. a -> (a -> b) -> b
& Lens' IdeTypeOperator (Maybe SourceType)
ideTypeOpKind forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe SourceType
k)
resolveOperator IdeDeclaration
x = IdeDeclaration
x
mapIf :: Functor f => (b -> Bool) -> (b -> b) -> f b -> f b
mapIf :: forall (f :: * -> *) b.
Functor f =>
(b -> Bool) -> (b -> b) -> f b -> f b
mapIf b -> Bool
p b -> b
f = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (\b
x -> if b -> Bool
p b
x then b -> b
f b
x else b
x)
resolveDataConstructorsForModule
:: [IdeDeclarationAnn]
-> [IdeDeclarationAnn]
resolveDataConstructorsForModule :: [IdeDeclarationAnn] -> [IdeDeclarationAnn]
resolveDataConstructorsForModule [IdeDeclarationAnn]
decls =
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (Lens' IdeDeclarationAnn IdeDeclaration
idaDeclaration forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ IdeDeclaration -> IdeDeclaration
resolveDataConstructors) [IdeDeclarationAnn]
decls
where
resolveDataConstructors :: IdeDeclaration -> IdeDeclaration
resolveDataConstructors :: IdeDeclaration -> IdeDeclaration
resolveDataConstructors IdeDeclaration
decl = case IdeDeclaration
decl of
IdeDeclType IdeType
ty ->
IdeType -> IdeDeclaration
IdeDeclType (IdeType
ty forall a b. a -> (a -> b) -> b
& Lens' IdeType [(ProperName 'ConstructorName, SourceType)]
ideTypeDtors forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall a. a -> Maybe a -> a
fromMaybe [] (forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (IdeType
ty forall s a. s -> Getting a s a -> a
^. Lens' IdeType (ProperName 'TypeName)
ideTypeName) Map
(ProperName 'TypeName) [(ProperName 'ConstructorName, SourceType)]
dtors))
IdeDeclaration
_ ->
IdeDeclaration
decl
dtors :: Map
(ProperName 'TypeName) [(ProperName 'ConstructorName, SourceType)]
dtors =
[IdeDeclarationAnn]
decls
forall a b. a -> (a -> b) -> b
& forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview (Lens' IdeDeclarationAnn IdeDeclaration
idaDeclaration forall b c a. (b -> c) -> (a -> b) -> a -> c
. Traversal' IdeDeclaration IdeDataConstructor
_IdeDeclDataConstructor))
forall a b. a -> (a -> b) -> b
& forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\(IdeDataConstructor ProperName 'ConstructorName
name ProperName 'TypeName
typeName SourceType
type') ->
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWith forall a. Semigroup a => a -> a -> a
(<>) ProperName 'TypeName
typeName [(ProperName 'ConstructorName
name, SourceType
type')]) forall k a. Map k a
Map.empty