-----------------------------------------------------------------------------
--
-- Module      : Language.PureScript.Ide.State
-- Description : Functions to access psc-ide's state
-- Copyright   : Christoph Hegemann 2016
-- License     : MIT (http://opensource.org/licenses/MIT)
--
-- Maintainer  : Christoph Hegemann <christoph.hegemann1337@gmail.com>
-- Stability   : experimental
--
-- |
-- Functions to access psc-ide's state
-----------------------------------------------------------------------------

{-# LANGUAGE PackageImports #-}
{-# LANGUAGE TypeApplications #-}

module Language.PureScript.Ide.State
  ( getLoadedModulenames
  , getExternFiles
  , getFileState
  , resetIdeState
  , cacheRebuild
  , cachedRebuild
  , insertExterns
  , insertModule
  , insertExternsSTM
  , getAllModules
  , populateVolatileState
  , populateVolatileStateSync
  , populateVolatileStateSTM
  , getOutputDirectory
  , updateCacheTimestamp
  -- for tests
  , resolveOperatorsForModule
  , resolveInstances
  , resolveDataConstructorsForModule
  ) where

import           Protolude hiding (moduleName, unzip)

import           Control.Concurrent.STM
import           Control.Lens                       hiding (anyOf, op, (&))
import           "monad-logger" Control.Monad.Logger
import           Data.IORef
import qualified Data.Map.Lazy                      as Map
import           Data.Time.Clock (UTCTime)
import           Data.Zip (unzip)
import qualified Language.PureScript                as P
import           Language.PureScript.Docs.Convert.Single (convertComments)
import           Language.PureScript.Externs
import           Language.PureScript.Make.Actions (cacheDbFile)
import           Language.PureScript.Ide.Externs
import           Language.PureScript.Ide.Reexports
import           Language.PureScript.Ide.SourceFile
import           Language.PureScript.Ide.Types
import           Language.PureScript.Ide.Util
import           System.Directory (getModificationTime)

-- | Resets all State inside psc-ide
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))

-- | Gets the loaded Modulenames
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

-- | Gets all loaded ExternFiles
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

-- | Insert a Module into Stage1 of the State
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'

-- | STM version of insertModule
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))}}

-- | Retrieves the FileState from the State. This includes loaded Externfiles
-- and parsed Modules
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)

-- | STM version of getFileState
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

-- | Retrieves VolatileState from the State.
-- This includes the denormalized Declarations and cached rebuilds
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))

-- | STM version of getVolatileState
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

-- | Sets the VolatileState inside Ide's state
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 ()

-- | Checks if the given ModuleName matches the last rebuild cache and if it
-- does returns all loaded definitions + the definitions inside the rebuild
-- cache
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

-- | Adds an ExternsFile into psc-ide's FileState. This does not populate the
-- VolatileState, which needs to be done after all the necessary Externs and
-- SourceFiles have been loaded.
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))

-- | STM version of insertExterns
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))}}

-- | Sets rebuild cache to the given ExternsFile
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)}}

-- | Retrieves the rebuild cache
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

-- | Resolves reexports and populates VolatileState with data to be used in queries.
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)
  -- populateVolatileState return Unit for now, so it's fine to discard this
  -- result. We might want to block on this in a benchmarking situation.
  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)))

-- | STM version of populateVolatileState
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
  -- We're not using the cached rebuild for anything other than preserving it
  -- through the repopulation
  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 -- type classes live in the type namespace
      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

-- | Looks up the types and kinds for operators and assigns them to their
-- declarations
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