{-# LANGUAGE CPP #-}
module Development.IDE.GHC.Util(
modifyDynFlags,
evalGhcEnv,
printRdrName,
Development.IDE.GHC.Util.printName,
ParseResult(..), runParser,
lookupPackageConfig,
textToStringBuffer,
bytestringToStringBuffer,
stringBufferToByteString,
moduleImportPath,
cgGutsToCoreModule,
fingerprintToBS,
fingerprintFromByteString,
fingerprintFromStringBuffer,
fingerprintFromPut,
readFileUtf8,
hDuplicateTo',
setHieDir,
dontWriteHieFiles,
disableWarningsAsErrors,
printOutputable,
getExtensions
) where
import Control.Concurrent
import Control.Exception as E
import Data.Binary.Put (Put, runPut)
import qualified Data.ByteString as BS
import Data.ByteString.Internal (ByteString (..))
import qualified Data.ByteString.Internal as BS
import qualified Data.ByteString.Lazy as LBS
import Data.IORef
import Data.List.Extra
import Data.Maybe
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import qualified Data.Text.Encoding.Error as T
import Data.Typeable
import Development.IDE.GHC.Compat as GHC hiding (unitState)
import qualified Development.IDE.GHC.Compat.Parser as Compat
import qualified Development.IDE.GHC.Compat.Units as Compat
import Development.IDE.Types.Location
import Foreign.ForeignPtr
import Foreign.Ptr
import Foreign.Storable
import GHC hiding (ParsedModule (..),
parser)
import GHC.IO.BufferedIO (BufferedIO)
import GHC.IO.Device as IODevice
import GHC.IO.Encoding
import GHC.IO.Exception
import GHC.IO.Handle.Internals
import GHC.IO.Handle.Types
import Ide.PluginUtils (unescape)
import System.FilePath
import GHC.Data.EnumSet
import GHC.Data.FastString
import GHC.Data.StringBuffer
import GHC.Utils.Fingerprint
modifyDynFlags :: GhcMonad m => (DynFlags -> DynFlags) -> m ()
modifyDynFlags :: forall (m :: * -> *). GhcMonad m => (DynFlags -> DynFlags) -> m ()
modifyDynFlags DynFlags -> DynFlags
f = do
DynFlags
newFlags <- DynFlags -> DynFlags
f forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). GhcMonad m => m DynFlags
getSessionDynFlags
forall (m :: * -> *). GhcMonad m => (HscEnv -> HscEnv) -> m ()
modifySession forall a b. (a -> b) -> a -> b
$ \HscEnv
h ->
DynFlags -> HscEnv -> HscEnv
hscSetFlags DynFlags
newFlags HscEnv
h { hsc_IC :: InteractiveContext
hsc_IC = (HscEnv -> InteractiveContext
hsc_IC HscEnv
h) {ic_dflags :: DynFlags
ic_dflags = DynFlags
newFlags} }
lookupPackageConfig :: Unit -> HscEnv -> Maybe GHC.UnitInfo
lookupPackageConfig :: Unit -> HscEnv -> Maybe UnitInfo
lookupPackageConfig Unit
unit HscEnv
env =
Bool -> UnitInfoMap -> PreloadUnitClosure -> Unit -> Maybe UnitInfo
Compat.lookupUnit' Bool
False UnitInfoMap
unitState PreloadUnitClosure
prClsre Unit
unit
where
unitState :: UnitInfoMap
unitState = HscEnv -> UnitInfoMap
Compat.getUnitInfoMap HscEnv
env
prClsre :: PreloadUnitClosure
prClsre = HscEnv -> PreloadUnitClosure
preloadClosureUs HscEnv
env
textToStringBuffer :: T.Text -> StringBuffer
textToStringBuffer :: Text -> StringBuffer
textToStringBuffer = FilePath -> StringBuffer
stringToStringBuffer forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> FilePath
T.unpack
runParser :: DynFlags -> String -> P a -> ParseResult a
runParser :: forall a. DynFlags -> FilePath -> P a -> ParseResult a
runParser DynFlags
flags FilePath
str P a
parser = forall a. P a -> PState -> ParseResult a
unP P a
parser PState
parseState
where
filename :: FilePath
filename = FilePath
"<interactive>"
location :: RealSrcLoc
location = FastString -> Int -> Int -> RealSrcLoc
mkRealSrcLoc (FilePath -> FastString
mkFastString FilePath
filename) Int
1 Int
1
buffer :: StringBuffer
buffer = FilePath -> StringBuffer
stringToStringBuffer FilePath
str
parseState :: PState
parseState = ParserOpts -> StringBuffer -> RealSrcLoc -> PState
Compat.initParserState (DynFlags -> ParserOpts
Compat.initParserOpts DynFlags
flags) StringBuffer
buffer RealSrcLoc
location
stringBufferToByteString :: StringBuffer -> ByteString
stringBufferToByteString :: StringBuffer -> ByteString
stringBufferToByteString StringBuffer{Int
ForeignPtr Word8
buf :: StringBuffer -> ForeignPtr Word8
cur :: StringBuffer -> Int
len :: StringBuffer -> Int
cur :: Int
len :: Int
buf :: ForeignPtr Word8
..} = ForeignPtr Word8 -> Int -> Int -> ByteString
PS ForeignPtr Word8
buf Int
cur Int
len
bytestringToStringBuffer :: ByteString -> StringBuffer
bytestringToStringBuffer :: ByteString -> StringBuffer
bytestringToStringBuffer (PS ForeignPtr Word8
buf Int
cur Int
len) = StringBuffer{Int
ForeignPtr Word8
len :: Int
cur :: Int
buf :: ForeignPtr Word8
buf :: ForeignPtr Word8
cur :: Int
len :: Int
..}
printRdrName :: RdrName -> String
printRdrName :: RdrName -> FilePath
printRdrName RdrName
name = Text -> FilePath
T.unpack forall a b. (a -> b) -> a -> b
$ forall a. Outputable a => a -> Text
printOutputable forall a b. (a -> b) -> a -> b
$ OccName -> SDoc -> SDoc
parenSymOcc OccName
rn (forall a. Outputable a => a -> SDoc
ppr OccName
rn)
where
rn :: OccName
rn = RdrName -> OccName
rdrNameOcc RdrName
name
printName :: Name -> String
printName :: Name -> FilePath
printName = RdrName -> FilePath
printRdrName forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> RdrName
nameRdrName
evalGhcEnv :: HscEnv -> Ghc b -> IO b
evalGhcEnv :: forall b. HscEnv -> Ghc b -> IO b
evalGhcEnv HscEnv
env Ghc b
act = forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. HscEnv -> Ghc a -> IO (HscEnv, a)
runGhcEnv HscEnv
env Ghc b
act
runGhcEnv :: HscEnv -> Ghc a -> IO (HscEnv, a)
runGhcEnv :: forall a. HscEnv -> Ghc a -> IO (HscEnv, a)
runGhcEnv HscEnv
env Ghc a
act = do
HscEnv
hsc_env <- HscEnv -> IO HscEnv
initTempFs HscEnv
env
IORef HscEnv
ref <- forall a. a -> IO (IORef a)
newIORef HscEnv
hsc_env
a
res <- forall a. Ghc a -> Session -> IO a
unGhc (forall (m :: * -> *) a. GhcMonad m => m a -> m a
withCleanupSession Ghc a
act) (IORef HscEnv -> Session
Session IORef HscEnv
ref)
(,a
res) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. IORef a -> IO a
readIORef IORef HscEnv
ref
moduleImportPath :: NormalizedFilePath -> GHC.ModuleName -> Maybe FilePath
moduleImportPath :: NormalizedFilePath -> ModuleName -> Maybe FilePath
moduleImportPath (FilePath -> FilePath
takeDirectory forall b c a. (b -> c) -> (a -> b) -> a -> c
. NormalizedFilePath -> FilePath
fromNormalizedFilePath -> FilePath
pathDir) ModuleName
mn
| FilePath
modDir forall a. Eq a => a -> a -> Bool
== FilePath
"." = forall a. a -> Maybe a
Just FilePath
pathDir
| Bool
otherwise = FilePath -> FilePath
dropTrailingPathSeparator forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Eq a => [a] -> [a] -> Maybe [a]
stripSuffix FilePath
modDir FilePath
pathDir
where
modDir :: FilePath
modDir =
FilePath -> FilePath
takeDirectory forall a b. (a -> b) -> a -> b
$
NormalizedFilePath -> FilePath
fromNormalizedFilePath forall a b. (a -> b) -> a -> b
$ FilePath -> NormalizedFilePath
toNormalizedFilePath' forall a b. (a -> b) -> a -> b
$
ModuleName -> FilePath
moduleNameSlashes ModuleName
mn
readFileUtf8 :: FilePath -> IO T.Text
readFileUtf8 :: FilePath -> IO Text
readFileUtf8 FilePath
f = OnDecodeError -> ByteString -> Text
T.decodeUtf8With OnDecodeError
T.lenientDecode forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO ByteString
BS.readFile FilePath
f
cgGutsToCoreModule :: SafeHaskellMode -> CgGuts -> ModDetails -> CoreModule
cgGutsToCoreModule :: SafeHaskellMode -> CgGuts -> ModDetails -> CoreModule
cgGutsToCoreModule SafeHaskellMode
safeMode CgGuts
guts ModDetails
modDetails = Module -> TypeEnv -> CoreProgram -> SafeHaskellMode -> CoreModule
CoreModule
(CgGuts -> Module
cg_module CgGuts
guts)
(ModDetails -> TypeEnv
md_types ModDetails
modDetails)
(CgGuts -> CoreProgram
cg_binds CgGuts
guts)
SafeHaskellMode
safeMode
fingerprintToBS :: Fingerprint -> BS.ByteString
fingerprintToBS :: Fingerprint -> ByteString
fingerprintToBS (Fingerprint Word64
a Word64
b) = Int -> (Ptr Word8 -> IO ()) -> ByteString
BS.unsafeCreate Int
8 forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ptr -> do
Ptr Word64
ptr' <- forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. Ptr a -> Ptr b
castPtr Ptr Word8
ptr
forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff Ptr Word64
ptr' Int
0 Word64
a
forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff Ptr Word64
ptr' Int
1 Word64
b
fingerprintFromStringBuffer :: StringBuffer -> IO Fingerprint
fingerprintFromStringBuffer :: StringBuffer -> IO Fingerprint
fingerprintFromStringBuffer (StringBuffer ForeignPtr Word8
buf Int
len Int
cur) =
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
buf forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ptr -> Ptr Word8 -> Int -> IO Fingerprint
fingerprintData (Ptr Word8
ptr forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
cur) Int
len
fingerprintFromByteString :: ByteString -> IO Fingerprint
fingerprintFromByteString :: ByteString -> IO Fingerprint
fingerprintFromByteString ByteString
bs = do
let (ForeignPtr Word8
fptr, Int
offset, Int
len) = ByteString -> (ForeignPtr Word8, Int, Int)
BS.toForeignPtr ByteString
bs
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
fptr forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ptr ->
Ptr Word8 -> Int -> IO Fingerprint
fingerprintData (Ptr Word8
ptr forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
offset) Int
len
fingerprintFromPut :: Put -> IO Fingerprint
fingerprintFromPut :: Put -> IO Fingerprint
fingerprintFromPut = ByteString -> IO Fingerprint
fingerprintFromByteString forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
LBS.toStrict forall b c a. (b -> c) -> (a -> b) -> a -> c
. Put -> ByteString
runPut
hDuplicateTo' :: Handle -> Handle -> IO ()
hDuplicateTo' :: Handle -> Handle -> IO ()
hDuplicateTo' h1 :: Handle
h1@(FileHandle FilePath
path MVar Handle__
m1) h2 :: Handle
h2@(FileHandle FilePath
_ MVar Handle__
m2) = do
FilePath
-> Handle -> MVar Handle__ -> (Handle__ -> IO Handle__) -> IO ()
withHandle__' FilePath
"hDuplicateTo" Handle
h2 MVar Handle__
m2 forall a b. (a -> b) -> a -> b
$ \Handle__
h2_ -> do
()
_ <- Handle__ -> IO ()
flushWriteBuffer Handle__
h2_ forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`E.catch` \(IOException
_ :: IOException) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
forall a.
FilePath -> Handle -> MVar Handle__ -> (Handle__ -> IO a) -> IO a
withHandle_' FilePath
"hDuplicateTo" Handle
h1 MVar Handle__
m1 forall a b. (a -> b) -> a -> b
$ \Handle__
h1_ -> do
FilePath
-> Handle
-> Maybe (MVar Handle__)
-> Handle__
-> Handle__
-> Maybe HandleFinalizer
-> IO Handle__
dupHandleTo FilePath
path Handle
h1 forall a. Maybe a
Nothing Handle__
h2_ Handle__
h1_ (forall a. a -> Maybe a
Just HandleFinalizer
handleFinalizer)
hDuplicateTo' h1 :: Handle
h1@(DuplexHandle FilePath
path MVar Handle__
r1 MVar Handle__
w1) h2 :: Handle
h2@(DuplexHandle FilePath
_ MVar Handle__
r2 MVar Handle__
w2) = do
FilePath
-> Handle -> MVar Handle__ -> (Handle__ -> IO Handle__) -> IO ()
withHandle__' FilePath
"hDuplicateTo" Handle
h2 MVar Handle__
w2 forall a b. (a -> b) -> a -> b
$ \Handle__
w2_ -> do
(Handle__, Maybe SomeException)
_ <- Handle__ -> IO (Handle__, Maybe SomeException)
hClose_help Handle__
w2_
forall a.
FilePath -> Handle -> MVar Handle__ -> (Handle__ -> IO a) -> IO a
withHandle_' FilePath
"hDuplicateTo" Handle
h1 MVar Handle__
w1 forall a b. (a -> b) -> a -> b
$ \Handle__
w1_ -> do
FilePath
-> Handle
-> Maybe (MVar Handle__)
-> Handle__
-> Handle__
-> Maybe HandleFinalizer
-> IO Handle__
dupHandleTo FilePath
path Handle
h1 forall a. Maybe a
Nothing Handle__
w2_ Handle__
w1_ (forall a. a -> Maybe a
Just HandleFinalizer
handleFinalizer)
FilePath
-> Handle -> MVar Handle__ -> (Handle__ -> IO Handle__) -> IO ()
withHandle__' FilePath
"hDuplicateTo" Handle
h2 MVar Handle__
r2 forall a b. (a -> b) -> a -> b
$ \Handle__
r2_ -> do
(Handle__, Maybe SomeException)
_ <- Handle__ -> IO (Handle__, Maybe SomeException)
hClose_help Handle__
r2_
forall a.
FilePath -> Handle -> MVar Handle__ -> (Handle__ -> IO a) -> IO a
withHandle_' FilePath
"hDuplicateTo" Handle
h1 MVar Handle__
r1 forall a b. (a -> b) -> a -> b
$ \Handle__
r1_ -> do
FilePath
-> Handle
-> Maybe (MVar Handle__)
-> Handle__
-> Handle__
-> Maybe HandleFinalizer
-> IO Handle__
dupHandleTo FilePath
path Handle
h1 (forall a. a -> Maybe a
Just MVar Handle__
w1) Handle__
r2_ Handle__
r1_ forall a. Maybe a
Nothing
hDuplicateTo' Handle
h1 Handle
_ =
forall a. Handle -> IO a
ioe_dupHandlesNotCompatible Handle
h1
dupHandleTo :: FilePath
-> Handle
-> Maybe (MVar Handle__)
-> Handle__
-> Handle__
-> Maybe HandleFinalizer
-> IO Handle__
dupHandleTo :: FilePath
-> Handle
-> Maybe (MVar Handle__)
-> Handle__
-> Handle__
-> Maybe HandleFinalizer
-> IO Handle__
dupHandleTo FilePath
filepath Handle
h Maybe (MVar Handle__)
other_side
_hto_ :: Handle__
_hto_@Handle__{haDevice :: ()
haDevice=dev
devTo}
h_ :: Handle__
h_@Handle__{haDevice :: ()
haDevice=dev
dev} Maybe HandleFinalizer
mb_finalizer = do
Handle__ -> IO ()
flushBuffer Handle__
h_
case forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast dev
devTo of
Maybe dev
Nothing -> forall a. Handle -> IO a
ioe_dupHandlesNotCompatible Handle
h
Just dev
dev' -> do
dev
_ <- forall a. IODevice a => a -> a -> IO a
IODevice.dup2 dev
dev dev
dev'
FileHandle FilePath
_ MVar Handle__
m <- forall dev.
(RawIO dev, IODevice dev, BufferedIO dev, Typeable dev) =>
dev
-> FilePath
-> Maybe (MVar Handle__)
-> Handle__
-> Maybe HandleFinalizer
-> IO Handle
dupHandle_ dev
dev' FilePath
filepath Maybe (MVar Handle__)
other_side Handle__
h_ Maybe HandleFinalizer
mb_finalizer
forall a. MVar a -> IO a
takeMVar MVar Handle__
m
dupHandle_ :: (RawIO dev, IODevice dev, BufferedIO dev, Typeable dev) => dev
-> FilePath
-> Maybe (MVar Handle__)
-> Handle__
-> Maybe HandleFinalizer
-> IO Handle
dupHandle_ :: forall dev.
(RawIO dev, IODevice dev, BufferedIO dev, Typeable dev) =>
dev
-> FilePath
-> Maybe (MVar Handle__)
-> Handle__
-> Maybe HandleFinalizer
-> IO Handle
dupHandle_ dev
new_dev FilePath
filepath Maybe (MVar Handle__)
other_side Handle__{dev
Maybe TextEncoding
Maybe (TextEncoder enc_state)
Maybe (TextDecoder dec_state)
Maybe (MVar Handle__)
Newline
HandleType
BufferMode
IORef (dec_state, Buffer Word8)
IORef (BufferList Char)
IORef (Buffer Char)
IORef (Buffer Word8)
haBufferMode :: Handle__ -> BufferMode
haBuffers :: Handle__ -> IORef (BufferList Char)
haByteBuffer :: Handle__ -> IORef (Buffer Word8)
haCharBuffer :: Handle__ -> IORef (Buffer Char)
haCodec :: Handle__ -> Maybe TextEncoding
haDecoder :: ()
haEncoder :: ()
haInputNL :: Handle__ -> Newline
haLastDecode :: ()
haOtherSide :: Handle__ -> Maybe (MVar Handle__)
haOutputNL :: Handle__ -> Newline
haType :: Handle__ -> HandleType
haOtherSide :: Maybe (MVar Handle__)
haOutputNL :: Newline
haInputNL :: Newline
haCodec :: Maybe TextEncoding
haDecoder :: Maybe (TextDecoder dec_state)
haEncoder :: Maybe (TextEncoder enc_state)
haBuffers :: IORef (BufferList Char)
haCharBuffer :: IORef (Buffer Char)
haLastDecode :: IORef (dec_state, Buffer Word8)
haBufferMode :: BufferMode
haByteBuffer :: IORef (Buffer Word8)
haType :: HandleType
haDevice :: dev
haDevice :: ()
..} Maybe HandleFinalizer
mb_finalizer = do
Maybe TextEncoding
mb_codec <- if forall a. Maybe a -> Bool
isJust Maybe (TextEncoder enc_state)
haEncoder then forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Maybe a
Just IO TextEncoding
getLocaleEncoding else forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
forall dev.
(RawIO dev, IODevice dev, BufferedIO dev, Typeable dev) =>
dev
-> FilePath
-> HandleType
-> Bool
-> Maybe TextEncoding
-> NewlineMode
-> Maybe HandleFinalizer
-> Maybe (MVar Handle__)
-> IO Handle
mkHandle dev
new_dev FilePath
filepath HandleType
haType Bool
True Maybe TextEncoding
mb_codec
NewlineMode { inputNL :: Newline
inputNL = Newline
haInputNL, outputNL :: Newline
outputNL = Newline
haOutputNL }
Maybe HandleFinalizer
mb_finalizer Maybe (MVar Handle__)
other_side
ioe_dupHandlesNotCompatible :: Handle -> IO a
ioe_dupHandlesNotCompatible :: forall a. Handle -> IO a
ioe_dupHandlesNotCompatible Handle
h =
forall a. IOException -> IO a
ioException (Maybe Handle
-> IOErrorType
-> FilePath
-> FilePath
-> Maybe CInt
-> Maybe FilePath
-> IOException
IOError (forall a. a -> Maybe a
Just Handle
h) IOErrorType
IllegalOperation FilePath
"hDuplicateTo"
FilePath
"handles are incompatible" forall a. Maybe a
Nothing forall a. Maybe a
Nothing)
printOutputable :: Outputable a => a -> T.Text
printOutputable :: forall a. Outputable a => a -> Text
printOutputable =
Text -> Text
unescape forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Outputable a => a -> FilePath
printWithoutUniques
{-# INLINE printOutputable #-}
getExtensions :: ParsedModule -> [Extension]
getExtensions :: ParsedModule -> [Extension]
getExtensions = forall a. Enum a => EnumSet a -> [a]
toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. DynFlags -> EnumSet Extension
extensionFlags forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModSummary -> DynFlags
ms_hspp_opts forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParsedModule -> ModSummary
pm_mod_summary