{-# LANGUAGE CPP #-}
-- Copyright (c) 2019 The DAML Authors. All rights reserved.
-- SPDX-License-Identifier: Apache-2.0

-- | General utility functions, mostly focused around GHC operations.
module Development.IDE.GHC.Util(
    modifyDynFlags,
    evalGhcEnv,
    -- * GHC wrappers
    printRdrName,
    Development.IDE.GHC.Util.printName,
    ParseResult(..), runParser,
    lookupPackageConfig,
    textToStringBuffer,
    bytestringToStringBuffer,
    stringBufferToByteString,
    moduleImportPath,
    cgGutsToCoreModule,
    fingerprintToBS,
    fingerprintFromByteString,
    fingerprintFromStringBuffer,
    fingerprintFromPut,
    -- * General utilities
    readFileUtf8,
    hDuplicateTo',
    setHieDir,
    dontWriteHieFiles,
    disableWarningsAsErrors,
    printOutputable,
    getExtensions
    ) where

#if MIN_VERSION_ghc(9,2,0)
import           GHC.Data.EnumSet
import           GHC.Data.FastString
import           GHC.Data.StringBuffer
import           GHC.Driver.Env                    hiding (hscSetFlags)
import           GHC.Driver.Monad
import           GHC.Driver.Session                hiding (ExposePackage)
import           GHC.Parser.Lexer
import           GHC.Runtime.Context
import           GHC.Types.Name.Occurrence
import           GHC.Types.Name.Reader
import           GHC.Types.SrcLoc
import           GHC.Unit.Module.ModDetails
import           GHC.Unit.Module.ModGuts
import           GHC.Utils.Fingerprint
import           GHC.Utils.Outputable
#else
import           Development.IDE.GHC.Compat.Util
#endif
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.Data                         (Data)
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.Time.Clock.POSIX             (POSIXTime, getCurrentTime,
                                                    utcTimeToPOSIXSeconds)
import           Data.Typeable
import qualified Data.Unique                       as U
import           Debug.Trace
import           Development.IDE.GHC.Compat        as GHC
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 (..))
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           GHC.Stack
import           Ide.PluginUtils                   (unescape)
import           System.Environment.Blank          (getEnvDefault)
import           System.FilePath
import           System.IO.Unsafe
import           Text.Printf


----------------------------------------------------------------------
-- 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 :: 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
  -- We do not use setSessionDynFlags here since we handle package
  -- initialization separately.
  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} }

-- | Given a 'Unit' try and find the associated 'PackageConfig' in the environment.
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


-- | 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 :: 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
..}

-- | Pretty print a 'RdrName' wrapping operators in parens
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

-- | Pretty print a 'Name' wrapping operators in parens
printName :: Name -> String
printName :: Name -> FilePath
printName = RdrName -> FilePath
printRdrName forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> RdrName
nameRdrName

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

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

-- | 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.ModuleName -> Maybe FilePath
-- The call to takeDirectory is required since DAML does not require that
-- the file name matches the module name in the last component.
-- Once that has changed we can get rid of this.
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
    -- This happens for single-component modules since takeDirectory "A" == "."
    | 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
    -- A for module A.B
    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

-- | Read a UTF8 file, with lenient decoding, so it will never raise a decoding error.
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

-- | Convert from a 'CgGuts' to a 'CoreModule'.
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

-- | Convert a 'Fingerprint' to a 'ByteString' by copying the byte across.
--   Will produce an 8 byte unreadable ByteString.
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

-- | Take the 'Fingerprint' of a 'StringBuffer'.
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

-- | A slightly modified version of 'hDuplicateTo' from GHC.
--   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 :: 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
   -- The implementation in base has this call to hClose_help.
   -- _ <- hClose_help h2_
   -- hClose_help does two things:
   -- 1. It flushes the buffer, we replicate this here
   ()
_ <- 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 ()
   -- 2. It closes the handle. This is redundant since dup2 takes care of that
   -- but even worse it is actively harmful! Once the handle has been closed
   -- another thread is free to reallocate it. This leads to dup2 failing with EBUSY
   -- if it happens just in the right moment.
   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

-- | This is copied unmodified from GHC since it is not exposed.
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

-- | This is copied unmodified from GHC since it is not exposed.
-- Note the beautiful inline comment!
#if MIN_VERSION_ghc(9,0,0)
dupHandle_ :: (RawIO dev, IODevice dev, BufferedIO dev, Typeable dev) => dev
#else
dupHandle_ :: (IODevice dev, BufferedIO dev, Typeable dev) => dev
#endif
           -> 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
   -- XXX wrong!
  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{-buffered-} Maybe TextEncoding
mb_codec
      NewlineMode { inputNL :: Newline
inputNL = Newline
haInputNL, outputNL :: Newline
outputNL = Newline
haOutputNL }
      Maybe HandleFinalizer
mb_finalizer Maybe (MVar Handle__)
other_side

-- | This is copied unmodified from GHC since it is not exposed.
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)

--------------------------------------------------------------------------------
-- Tracing exactprint terms

-- | Print a GHC value in `defaultUserStyle` without unique symbols.
-- It uses `showSDocUnsafe` with `unsafeGlobalDynFlags` internally.
--
-- This is the most common print utility.
-- It will do something additionally compared to what the 'Outputable' instance does.
--
--   1. print with a user-friendly style: `a_a4ME` as `a`.
--   2. unescape escape sequences of printable unicode characters within a pair of double quotes
printOutputable :: Outputable a => a -> T.Text
printOutputable :: forall a. Outputable a => a -> Text
printOutputable =
    -- IfaceTyLit from GHC.Iface.Type implements Outputable with 'show'.
    -- Showing a String escapes non-ascii printable characters. We unescape it here.
    -- More discussion at https://github.com/haskell/haskell-language-server/issues/3115.
    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