mirror of
https://github.com/haskell/ghcide.git
synced 2024-12-14 07:02:00 +03:00
Add documentation (#368)
* Add documentation for Util.hs * Add documentation to OfInterest
This commit is contained in:
parent
7e133ea59c
commit
19a346a3cc
@ -1,19 +1,17 @@
|
|||||||
-- Copyright (c) 2019 The DAML Authors. All rights reserved.
|
-- Copyright (c) 2019 The DAML Authors. All rights reserved.
|
||||||
-- SPDX-License-Identifier: Apache-2.0
|
-- SPDX-License-Identifier: Apache-2.0
|
||||||
|
|
||||||
|
{-# LANGUAGE TypeFamilies #-}
|
||||||
{-# LANGUAGE TypeFamilies #-}
|
|
||||||
{-# LANGUAGE FlexibleInstances #-}
|
{-# LANGUAGE FlexibleInstances #-}
|
||||||
|
|
||||||
-- | A Shake implementation of the compiler service, built
|
-- | Utilities and state for the files of interest - those which are currently
|
||||||
-- using the "Shaker" abstraction layer for in-memory use.
|
-- open in the editor. The useful function is 'getFilesOfInterest'.
|
||||||
--
|
|
||||||
module Development.IDE.Core.OfInterest(
|
module Development.IDE.Core.OfInterest(
|
||||||
ofInterestRules,
|
ofInterestRules,
|
||||||
getFilesOfInterest, setFilesOfInterest, modifyFilesOfInterest,
|
getFilesOfInterest, setFilesOfInterest, modifyFilesOfInterest,
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Control.Concurrent.Extra
|
import Control.Concurrent.Extra
|
||||||
import Data.Binary
|
import Data.Binary
|
||||||
import Data.Hashable
|
import Data.Hashable
|
||||||
import Control.DeepSeq
|
import Control.DeepSeq
|
||||||
@ -21,26 +19,23 @@ import GHC.Generics
|
|||||||
import Data.Typeable
|
import Data.Typeable
|
||||||
import qualified Data.ByteString.UTF8 as BS
|
import qualified Data.ByteString.UTF8 as BS
|
||||||
import Control.Exception
|
import Control.Exception
|
||||||
import Development.IDE.Types.Location
|
import Data.Set (Set)
|
||||||
import Development.IDE.Types.Logger
|
import qualified Data.Set as Set
|
||||||
import Data.Set (Set)
|
|
||||||
import qualified Data.Set as Set
|
|
||||||
import qualified Data.Text as T
|
import qualified Data.Text as T
|
||||||
import Data.Tuple.Extra
|
import Data.Tuple.Extra
|
||||||
import Data.Functor
|
import Data.Functor
|
||||||
import Development.Shake
|
import Development.Shake
|
||||||
|
|
||||||
import Development.IDE.Core.Shake
|
|
||||||
|
|
||||||
|
import Development.IDE.Types.Location
|
||||||
|
import Development.IDE.Types.Logger
|
||||||
|
import Development.IDE.Core.Shake
|
||||||
|
|
||||||
|
|
||||||
newtype OfInterestVar = OfInterestVar (Var (Set NormalizedFilePath))
|
newtype OfInterestVar = OfInterestVar (Var (Set NormalizedFilePath))
|
||||||
instance IsIdeGlobal OfInterestVar
|
instance IsIdeGlobal OfInterestVar
|
||||||
|
|
||||||
|
|
||||||
type instance RuleResult GetFilesOfInterest = Set NormalizedFilePath
|
type instance RuleResult GetFilesOfInterest = Set NormalizedFilePath
|
||||||
|
|
||||||
|
|
||||||
data GetFilesOfInterest = GetFilesOfInterest
|
data GetFilesOfInterest = GetFilesOfInterest
|
||||||
deriving (Eq, Show, Typeable, Generic)
|
deriving (Eq, Show, Typeable, Generic)
|
||||||
instance Hashable GetFilesOfInterest
|
instance Hashable GetFilesOfInterest
|
||||||
@ -48,6 +43,7 @@ instance NFData GetFilesOfInterest
|
|||||||
instance Binary GetFilesOfInterest
|
instance Binary GetFilesOfInterest
|
||||||
|
|
||||||
|
|
||||||
|
-- | The rule that initialises the files of interest state.
|
||||||
ofInterestRules :: Rules ()
|
ofInterestRules :: Rules ()
|
||||||
ofInterestRules = do
|
ofInterestRules = do
|
||||||
addIdeGlobal . OfInterestVar =<< liftIO (newVar Set.empty)
|
addIdeGlobal . OfInterestVar =<< liftIO (newVar Set.empty)
|
||||||
@ -57,6 +53,7 @@ ofInterestRules = do
|
|||||||
pure (Just $ BS.fromString $ show filesOfInterest, ([], Just filesOfInterest))
|
pure (Just $ BS.fromString $ show filesOfInterest, ([], Just filesOfInterest))
|
||||||
|
|
||||||
|
|
||||||
|
-- | Get the files that are open in the IDE.
|
||||||
getFilesOfInterest :: Action (Set NormalizedFilePath)
|
getFilesOfInterest :: Action (Set NormalizedFilePath)
|
||||||
getFilesOfInterest = useNoFile_ GetFilesOfInterest
|
getFilesOfInterest = useNoFile_ GetFilesOfInterest
|
||||||
|
|
||||||
@ -65,7 +62,8 @@ getFilesOfInterest = useNoFile_ GetFilesOfInterest
|
|||||||
------------------------------------------------------------
|
------------------------------------------------------------
|
||||||
-- Exposed API
|
-- Exposed API
|
||||||
|
|
||||||
-- | Set the files-of-interest which will be built and kept-up-to-date.
|
-- | Set the files-of-interest - not usually necessary or advisable.
|
||||||
|
-- The LSP client will keep this information up to date.
|
||||||
setFilesOfInterest :: IdeState -> Set NormalizedFilePath -> IO ()
|
setFilesOfInterest :: IdeState -> Set NormalizedFilePath -> IO ()
|
||||||
setFilesOfInterest state files = modifyFilesOfInterest state (const files)
|
setFilesOfInterest state files = modifyFilesOfInterest state (const files)
|
||||||
|
|
||||||
@ -74,6 +72,8 @@ getFilesOfInterestUntracked = do
|
|||||||
OfInterestVar var <- getIdeGlobalAction
|
OfInterestVar var <- getIdeGlobalAction
|
||||||
liftIO $ readVar var
|
liftIO $ readVar var
|
||||||
|
|
||||||
|
-- | Modify the files-of-interest - not usually necessary or advisable.
|
||||||
|
-- The LSP client will keep this information up to date.
|
||||||
modifyFilesOfInterest :: IdeState -> (Set NormalizedFilePath -> Set NormalizedFilePath) -> IO ()
|
modifyFilesOfInterest :: IdeState -> (Set NormalizedFilePath -> Set NormalizedFilePath) -> IO ()
|
||||||
modifyFilesOfInterest state f = do
|
modifyFilesOfInterest state f = do
|
||||||
OfInterestVar var <- getIdeGlobalState state
|
OfInterestVar var <- getIdeGlobalState state
|
||||||
|
@ -5,23 +5,22 @@
|
|||||||
{-# LANGUAGE CPP #-}
|
{-# LANGUAGE CPP #-}
|
||||||
#include "ghc-api-version.h"
|
#include "ghc-api-version.h"
|
||||||
|
|
||||||
-- | GHC utility functions. Importantly, code using our GHC should never:
|
-- | General utility functions, mostly focused around GHC operations.
|
||||||
--
|
|
||||||
-- * Call runGhc, use runGhcFast instead. It's faster and doesn't require config we don't have.
|
|
||||||
--
|
|
||||||
-- * Call setSessionDynFlags, use modifyDynFlags instead. It's faster and avoids loading packages.
|
|
||||||
module Development.IDE.GHC.Util(
|
module Development.IDE.GHC.Util(
|
||||||
lookupPackageConfig,
|
-- * HcsEnv and environment
|
||||||
|
HscEnvEq, hscEnv, newHscEnvEq,
|
||||||
modifyDynFlags,
|
modifyDynFlags,
|
||||||
fakeDynFlags,
|
fakeDynFlags,
|
||||||
prettyPrint,
|
|
||||||
runGhcEnv,
|
runGhcEnv,
|
||||||
textToStringBuffer,
|
-- * GHC wrappers
|
||||||
|
prettyPrint,
|
||||||
|
lookupPackageConfig,
|
||||||
moduleImportPath,
|
moduleImportPath,
|
||||||
HscEnvEq, hscEnv, newHscEnvEq,
|
cgGutsToCoreModule,
|
||||||
|
-- * General utilities
|
||||||
|
textToStringBuffer,
|
||||||
readFileUtf8,
|
readFileUtf8,
|
||||||
hDuplicateTo',
|
hDuplicateTo',
|
||||||
cgGutsToCoreModule
|
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Config
|
import Config
|
||||||
@ -60,6 +59,8 @@ import Development.IDE.Types.Location
|
|||||||
----------------------------------------------------------------------
|
----------------------------------------------------------------------
|
||||||
-- GHC setup
|
-- GHC setup
|
||||||
|
|
||||||
|
-- | Used to modify dyn flags in preference to calling 'setSessionDynFlags',
|
||||||
|
-- since that function also reloads packages (which is very slow).
|
||||||
modifyDynFlags :: GhcMonad m => (DynFlags -> DynFlags) -> m ()
|
modifyDynFlags :: GhcMonad m => (DynFlags -> DynFlags) -> m ()
|
||||||
modifyDynFlags f = do
|
modifyDynFlags f = do
|
||||||
newFlags <- f <$> getSessionDynFlags
|
newFlags <- f <$> getSessionDynFlags
|
||||||
@ -68,6 +69,7 @@ modifyDynFlags f = do
|
|||||||
modifySession $ \h ->
|
modifySession $ \h ->
|
||||||
h { hsc_dflags = newFlags, hsc_IC = (hsc_IC h) {ic_dflags = newFlags} }
|
h { hsc_dflags = newFlags, hsc_IC = (hsc_IC h) {ic_dflags = newFlags} }
|
||||||
|
|
||||||
|
-- | Given a 'UnitId' try and find the associated 'PackageConfig' in the environment.
|
||||||
lookupPackageConfig :: UnitId -> HscEnv -> Maybe PackageConfig
|
lookupPackageConfig :: UnitId -> HscEnv -> Maybe PackageConfig
|
||||||
lookupPackageConfig unitId env =
|
lookupPackageConfig unitId env =
|
||||||
lookupPackage' False pkgConfigMap unitId
|
lookupPackage' False pkgConfigMap unitId
|
||||||
@ -78,14 +80,18 @@ lookupPackageConfig unitId env =
|
|||||||
getPackageConfigMap $ hsc_dflags env
|
getPackageConfigMap $ hsc_dflags env
|
||||||
|
|
||||||
|
|
||||||
-- would be nice to do this more efficiently...
|
-- | Convert from the @text@ package to the @GHC@ 'StringBuffer'.
|
||||||
|
-- Currently implemented somewhat inefficiently (if it ever comes up in a profile).
|
||||||
textToStringBuffer :: T.Text -> StringBuffer
|
textToStringBuffer :: T.Text -> StringBuffer
|
||||||
textToStringBuffer = stringToStringBuffer . T.unpack
|
textToStringBuffer = stringToStringBuffer . T.unpack
|
||||||
|
|
||||||
|
|
||||||
|
-- | Pretty print a GHC value using 'fakeDynFlags'.
|
||||||
prettyPrint :: Outputable a => a -> String
|
prettyPrint :: Outputable a => a -> String
|
||||||
prettyPrint = showSDoc fakeDynFlags . ppr
|
prettyPrint = showSDoc fakeDynFlags . ppr
|
||||||
|
|
||||||
|
-- | Run a 'Ghc' monad value using an existing 'HscEnv'. Sets up and tears down all the required
|
||||||
|
-- pieces, but designed to be more efficient than a standard 'runGhc'.
|
||||||
runGhcEnv :: HscEnv -> Ghc a -> IO a
|
runGhcEnv :: HscEnv -> Ghc a -> IO a
|
||||||
runGhcEnv env act = do
|
runGhcEnv env act = do
|
||||||
filesToClean <- newIORef emptyFilesToClean
|
filesToClean <- newIORef emptyFilesToClean
|
||||||
@ -96,8 +102,8 @@ runGhcEnv env act = do
|
|||||||
cleanTempFiles dflags
|
cleanTempFiles dflags
|
||||||
cleanTempDirs dflags
|
cleanTempDirs dflags
|
||||||
|
|
||||||
-- Fake DynFlags which are mostly undefined, but define enough to do a
|
-- | A 'DynFlags' value where most things are undefined. It's sufficient to call pretty printing,
|
||||||
-- little bit.
|
-- but not much else.
|
||||||
fakeDynFlags :: DynFlags
|
fakeDynFlags :: DynFlags
|
||||||
fakeDynFlags = defaultDynFlags settings mempty
|
fakeDynFlags = defaultDynFlags settings mempty
|
||||||
where
|
where
|
||||||
@ -120,6 +126,9 @@ fakeDynFlags = defaultDynFlags settings mempty
|
|||||||
, pc_WORD_SIZE=8
|
, pc_WORD_SIZE=8
|
||||||
}
|
}
|
||||||
|
|
||||||
|
-- | Given a module location, and its parse tree, figure out what is the include directory implied by it.
|
||||||
|
-- For example, given the file @\/usr\/\Test\/Foo\/Bar.hs@ with the module name @Foo.Bar@ the directory
|
||||||
|
-- @\/usr\/Test@ should be on the include path to find sibling modules.
|
||||||
moduleImportPath :: NormalizedFilePath -> GHC.ParsedModule -> Maybe FilePath
|
moduleImportPath :: NormalizedFilePath -> GHC.ParsedModule -> Maybe FilePath
|
||||||
-- The call to takeDirectory is required since DAML does not require that
|
-- The call to takeDirectory is required since DAML does not require that
|
||||||
-- the file name matches the module name in the last component.
|
-- the file name matches the module name in the last component.
|
||||||
@ -137,12 +146,15 @@ moduleImportPath (takeDirectory . fromNormalizedFilePath -> pathDir) pm
|
|||||||
fromNormalizedFilePath $ toNormalizedFilePath $
|
fromNormalizedFilePath $ toNormalizedFilePath $
|
||||||
moduleNameSlashes $ GHC.moduleName mod'
|
moduleNameSlashes $ GHC.moduleName mod'
|
||||||
|
|
||||||
-- | An HscEnv with equality.
|
-- | An 'HscEnv' with equality. Two values are considered equal
|
||||||
|
-- if they are created with the same call to 'newHscEnvEq'.
|
||||||
data HscEnvEq = HscEnvEq Unique HscEnv
|
data HscEnvEq = HscEnvEq Unique HscEnv
|
||||||
|
|
||||||
|
-- | Unwrap an 'HsEnvEq'.
|
||||||
hscEnv :: HscEnvEq -> HscEnv
|
hscEnv :: HscEnvEq -> HscEnv
|
||||||
hscEnv (HscEnvEq _ x) = x
|
hscEnv (HscEnvEq _ x) = x
|
||||||
|
|
||||||
|
-- | Wrap an 'HscEnv' into an 'HscEnvEq'.
|
||||||
newHscEnvEq :: HscEnv -> IO HscEnvEq
|
newHscEnvEq :: HscEnv -> IO HscEnvEq
|
||||||
newHscEnvEq e = do u <- newUnique; return $ HscEnvEq u e
|
newHscEnvEq e = do u <- newUnique; return $ HscEnvEq u e
|
||||||
|
|
||||||
@ -155,9 +167,11 @@ instance Eq HscEnvEq where
|
|||||||
instance NFData HscEnvEq where
|
instance NFData HscEnvEq where
|
||||||
rnf (HscEnvEq a b) = rnf (hashUnique a) `seq` b `seq` ()
|
rnf (HscEnvEq a b) = rnf (hashUnique a) `seq` b `seq` ()
|
||||||
|
|
||||||
|
-- | Read a UTF8 file, with lenient decoding, so it will never raise a decoding error.
|
||||||
readFileUtf8 :: FilePath -> IO T.Text
|
readFileUtf8 :: FilePath -> IO T.Text
|
||||||
readFileUtf8 f = T.decodeUtf8With T.lenientDecode <$> BS.readFile f
|
readFileUtf8 f = T.decodeUtf8With T.lenientDecode <$> BS.readFile f
|
||||||
|
|
||||||
|
-- | Convert from a 'CgGuts' to a 'CoreModule'.
|
||||||
cgGutsToCoreModule :: SafeHaskellMode -> CgGuts -> ModDetails -> CoreModule
|
cgGutsToCoreModule :: SafeHaskellMode -> CgGuts -> ModDetails -> CoreModule
|
||||||
cgGutsToCoreModule safeMode guts modDetails = CoreModule
|
cgGutsToCoreModule safeMode guts modDetails = CoreModule
|
||||||
(cg_module guts)
|
(cg_module guts)
|
||||||
@ -165,8 +179,8 @@ cgGutsToCoreModule safeMode guts modDetails = CoreModule
|
|||||||
(cg_binds guts)
|
(cg_binds guts)
|
||||||
safeMode
|
safeMode
|
||||||
|
|
||||||
-- This is a slightly modified version of hDuplicateTo in GHC.
|
-- | A slightly modified version of 'hDuplicateTo' from GHC.
|
||||||
-- See the inline comment for more details.
|
-- Importantly, it avoids the bug listed in https://gitlab.haskell.org/ghc/ghc/merge_requests/2318.
|
||||||
hDuplicateTo' :: Handle -> Handle -> IO ()
|
hDuplicateTo' :: Handle -> Handle -> IO ()
|
||||||
hDuplicateTo' h1@(FileHandle path m1) h2@(FileHandle _ m2) = do
|
hDuplicateTo' h1@(FileHandle path m1) h2@(FileHandle _ m2) = do
|
||||||
withHandle__' "hDuplicateTo" h2 m2 $ \h2_ -> do
|
withHandle__' "hDuplicateTo" h2 m2 $ \h2_ -> do
|
||||||
|
Loading…
Reference in New Issue
Block a user