-- | A module providing various remote external variables which we want
-- available in any session. It gets compiled in-memory at the start of one.
--
-- See Note [debuggerInternal unit].
{-# LANGUAGE LambdaCase #-}
module GHC.Debugger.Runtime.Internal
  ( module GHC.Debugger.Runtime.Internal
  , GHC.evalWrapper
  , Prelude.concat
  , Prelude.putStrLn
  )
  where

import GHC.GHCi.Helpers qualified as GHC
import GHCi.RemoteTypes
import qualified Unsafe.Coerce
import GHC.Exts.Heap.Closures
import Data.Maybe
import Data.List
import GHC.Base (returnIO)
import qualified System.IO

-- | Some extensions can mess with [] and (:) syntax, so we setup these plain
-- function aliases.
nil :: [a]
nil :: forall a. [a]
nil = []

-- | See @nil@.
cons :: a -> [a] -> [a]
cons :: forall a. a -> [a] -> [a]
cons = (:)


-- Need to be careful not to create extra thunks in the returned `HValue`s, but
-- also avoid forcing the inside of a `Box`.
-- See Note [Forcing debuggee's thunks].
unpackStackField :: StackField -> IO HValue
unpackStackField :: StackField -> IO HValue
unpackStackField StackField
x = case StackField
x of
  (StackBox (Box Any
a)) -> HValue -> IO HValue
forall a. a -> IO a
returnIO (Any -> HValue
HValue Any
a)
  (StackWord Word
w) -> HValue -> IO HValue
forall a. a -> IO a
returnIO (Any -> HValue
HValue (Word -> Any
forall a b. a -> b
Unsafe.Coerce.unsafeCoerce Word
w))

unpackStackFields :: [StackField] -> Maybe [Int] -> IO [HValue]
unpackStackFields :: [StackField] -> Maybe [Int] -> IO [HValue]
unpackStackFields [StackField]
fs = \case
  Maybe [Int]
Nothing -> (StackField -> IO HValue) -> [StackField] -> IO [HValue]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM StackField -> IO HValue
unpackStackField [StackField]
fs
  Just [Int]
xs -> ((Int -> IO HValue) -> [Int] -> IO [HValue])
-> [Int] -> (Int -> IO HValue) -> IO [HValue]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Int -> IO HValue) -> [Int] -> IO [HValue]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM [Int]
xs ((Int -> IO HValue) -> IO [HValue])
-> (Int -> IO HValue) -> IO [HValue]
forall a b. (a -> b) -> a -> b
$ \ Int
i ->
       StackField -> IO HValue
unpackStackField (StackField -> Maybe StackField -> StackField
forall a. a -> Maybe a -> a
fromMaybe ([Char] -> StackField
forall a. HasCallStack => [Char] -> a
error ([Char]
"Looking up StackField: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
i)) ([StackField]
fs [StackField] -> Int -> Maybe StackField
forall a. [a] -> Int -> Maybe a
!? Int
i))

-- | We @setInteractivePrintName@ with this so REPL results are forced but not
-- already printed to debug console.
noPrintConstant :: a -> IO ()
noPrintConstant :: forall a. a -> IO ()
noPrintConstant a
x = a
x a -> IO () -> IO ()
forall a b. a -> b -> b
`seq` () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

setLineBuffering :: IO ()
setLineBuffering :: IO ()
setLineBuffering = do
 Handle -> BufferMode -> IO ()
System.IO.hSetBuffering Handle
System.IO.stdout BufferMode
System.IO.LineBuffering
 Handle -> BufferMode -> IO ()
System.IO.hSetBuffering Handle
System.IO.stderr BufferMode
System.IO.LineBuffering