Add documentation (#368)

* Add documentation for Util.hs

* Add documentation to OfInterest
This commit is contained in:
Neil Mitchell 2020-01-26 12:37:10 +00:00 committed by Moritz Kiefer
parent 7e133ea59c
commit 19a346a3cc
2 changed files with 46 additions and 32 deletions

View File

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

View File

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