-----------------------------------------------------------------------------
--
-- 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 (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)

-- | 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