{-# LANGUAGE NamedFieldPuns, DeriveFunctor, DerivingStrategies, GeneralizedNewtypeDeriving #-}
-- | Meant to be qualified with @import qualified GHC.Debugger.Breakpoint.Map as BM@
module GHC.Debugger.Breakpoint.Map
  ( BreakpointMap
  , insert
  , lookup
  , delete
  , empty
  , lookupModuleIBIs
  , keys
  , toList
  ) where

import Prelude hiding (lookup)
import qualified GHC
import GHC.Unit.Module.Env
import GHC.ByteCode.Breakpoints
import GHC.Utils.Outputable (Outputable)
import qualified Data.IntMap as IM
import GHC.Debugger.View.Class
import GHC.Debugger.Utils (showModule)

-- | A map keyed by 'InternalBreakpointId'
newtype BreakpointMap a = BreakpointMap (ModuleEnv (IM.IntMap a))
  deriving newtype BreakpointMap a -> SDoc
(BreakpointMap a -> SDoc) -> Outputable (BreakpointMap a)
forall a. Outputable a => BreakpointMap a -> SDoc
forall a. (a -> SDoc) -> Outputable a
$cppr :: forall a. Outputable a => BreakpointMap a -> SDoc
ppr :: BreakpointMap a -> SDoc
Outputable

insert :: GHC.InternalBreakpointId -> a -> BreakpointMap a -> BreakpointMap a
insert :: forall a.
InternalBreakpointId -> a -> BreakpointMap a -> BreakpointMap a
insert InternalBreakpointId{Module
ibi_info_mod :: Module
ibi_info_mod :: InternalBreakpointId -> Module
ibi_info_mod, BreakInfoIndex
ibi_info_index :: BreakInfoIndex
ibi_info_index :: InternalBreakpointId -> BreakInfoIndex
ibi_info_index}
        a
x (BreakpointMap ModuleEnv (IntMap a)
bm0) = ModuleEnv (IntMap a) -> BreakpointMap a
forall a. ModuleEnv (IntMap a) -> BreakpointMap a
BreakpointMap (ModuleEnv (IntMap a) -> BreakpointMap a)
-> ModuleEnv (IntMap a) -> BreakpointMap a
forall a b. (a -> b) -> a -> b
$
  case ModuleEnv (IntMap a) -> Module -> Maybe (IntMap a)
forall a. ModuleEnv a -> Module -> Maybe a
lookupModuleEnv ModuleEnv (IntMap a)
bm0 Module
ibi_info_mod of
    Maybe (IntMap a)
Nothing ->
      ModuleEnv (IntMap a) -> Module -> IntMap a -> ModuleEnv (IntMap a)
forall a. ModuleEnv a -> Module -> a -> ModuleEnv a
extendModuleEnv ModuleEnv (IntMap a)
bm0 Module
ibi_info_mod (IntMap a -> ModuleEnv (IntMap a))
-> IntMap a -> ModuleEnv (IntMap a)
forall a b. (a -> b) -> a -> b
$
        BreakInfoIndex -> a -> IntMap a
forall a. BreakInfoIndex -> a -> IntMap a
IM.singleton BreakInfoIndex
ibi_info_index a
x
    Just IntMap a
im ->
      ModuleEnv (IntMap a) -> Module -> IntMap a -> ModuleEnv (IntMap a)
forall a. ModuleEnv a -> Module -> a -> ModuleEnv a
extendModuleEnv ModuleEnv (IntMap a)
bm0 Module
ibi_info_mod (IntMap a -> ModuleEnv (IntMap a))
-> IntMap a -> ModuleEnv (IntMap a)
forall a b. (a -> b) -> a -> b
$
        BreakInfoIndex -> a -> IntMap a -> IntMap a
forall a. BreakInfoIndex -> a -> IntMap a -> IntMap a
IM.insert BreakInfoIndex
ibi_info_index a
x IntMap a
im

lookup :: GHC.InternalBreakpointId -> BreakpointMap a -> Maybe a
lookup :: forall a. InternalBreakpointId -> BreakpointMap a -> Maybe a
lookup InternalBreakpointId{Module
ibi_info_mod :: InternalBreakpointId -> Module
ibi_info_mod :: Module
ibi_info_mod, BreakInfoIndex
ibi_info_index :: InternalBreakpointId -> BreakInfoIndex
ibi_info_index :: BreakInfoIndex
ibi_info_index}
        (BreakpointMap ModuleEnv (IntMap a)
bm0) = do
  ModuleEnv (IntMap a) -> Module -> Maybe (IntMap a)
forall a. ModuleEnv a -> Module -> Maybe a
lookupModuleEnv ModuleEnv (IntMap a)
bm0 Module
ibi_info_mod
  Maybe (IntMap a) -> (IntMap a -> Maybe a) -> Maybe a
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= BreakInfoIndex -> IntMap a -> Maybe a
forall a. BreakInfoIndex -> IntMap a -> Maybe a
IM.lookup BreakInfoIndex
ibi_info_index

delete :: GHC.InternalBreakpointId -> BreakpointMap a -> BreakpointMap a
delete :: forall a.
InternalBreakpointId -> BreakpointMap a -> BreakpointMap a
delete InternalBreakpointId{Module
ibi_info_mod :: InternalBreakpointId -> Module
ibi_info_mod :: Module
ibi_info_mod, BreakInfoIndex
ibi_info_index :: InternalBreakpointId -> BreakInfoIndex
ibi_info_index :: BreakInfoIndex
ibi_info_index}
        (BreakpointMap ModuleEnv (IntMap a)
bm0) =
  case ModuleEnv (IntMap a) -> Module -> Maybe (IntMap a)
forall a. ModuleEnv a -> Module -> Maybe a
lookupModuleEnv ModuleEnv (IntMap a)
bm0 Module
ibi_info_mod of
    Maybe (IntMap a)
Nothing -> ModuleEnv (IntMap a) -> BreakpointMap a
forall a. ModuleEnv (IntMap a) -> BreakpointMap a
BreakpointMap ModuleEnv (IntMap a)
bm0
    Just IntMap a
im -> ModuleEnv (IntMap a) -> BreakpointMap a
forall a. ModuleEnv (IntMap a) -> BreakpointMap a
BreakpointMap (ModuleEnv (IntMap a) -> BreakpointMap a)
-> ModuleEnv (IntMap a) -> BreakpointMap a
forall a b. (a -> b) -> a -> b
$
      ModuleEnv (IntMap a) -> Module -> IntMap a -> ModuleEnv (IntMap a)
forall a. ModuleEnv a -> Module -> a -> ModuleEnv a
extendModuleEnv ModuleEnv (IntMap a)
bm0 Module
ibi_info_mod (IntMap a -> ModuleEnv (IntMap a))
-> IntMap a -> ModuleEnv (IntMap a)
forall a b. (a -> b) -> a -> b
$
        BreakInfoIndex -> IntMap a -> IntMap a
forall a. BreakInfoIndex -> IntMap a -> IntMap a
IM.delete BreakInfoIndex
ibi_info_index IntMap a
im

empty :: BreakpointMap a
empty :: forall a. BreakpointMap a
empty = ModuleEnv (IntMap a) -> BreakpointMap a
forall a. ModuleEnv (IntMap a) -> BreakpointMap a
BreakpointMap ModuleEnv (IntMap a)
forall a. ModuleEnv a
emptyModuleEnv

-- | Retrieves all 'InternalBreakpointId's for a given 'Module'
-- Note: The internal breakpoints of a module are not necessarily the same as
-- the source-level breakpoints, so this shouldn't be used to get all internal
-- breakpoints with source-level occurrences in the given module.
lookupModuleIBIs :: GHC.Module -> BreakpointMap a -> [InternalBreakpointId]
lookupModuleIBIs :: forall a. Module -> BreakpointMap a -> [InternalBreakpointId]
lookupModuleIBIs Module
m (BreakpointMap ModuleEnv (IntMap a)
bm) =
  case ModuleEnv (IntMap a) -> Module -> Maybe (IntMap a)
forall a. ModuleEnv a -> Module -> Maybe a
lookupModuleEnv ModuleEnv (IntMap a)
bm Module
m of
    Maybe (IntMap a)
Nothing -> []
    Just IntMap a
im ->
      [ Module -> BreakInfoIndex -> InternalBreakpointId
InternalBreakpointId Module
m BreakInfoIndex
bix
      | BreakInfoIndex
bix <- IntMap a -> [BreakInfoIndex]
forall a. IntMap a -> [BreakInfoIndex]
IM.keys IntMap a
im
      ]

keys :: BreakpointMap a -> [InternalBreakpointId]
keys :: forall a. BreakpointMap a -> [InternalBreakpointId]
keys (BreakpointMap ModuleEnv (IntMap a)
bm) =
  [ Module -> BreakInfoIndex -> InternalBreakpointId
InternalBreakpointId Module
m BreakInfoIndex
bix
  | (Module
m, IntMap a
im) <- ModuleEnv (IntMap a) -> [(Module, IntMap a)]
forall a. ModuleEnv a -> [(Module, a)]
moduleEnvToList ModuleEnv (IntMap a)
bm
  , BreakInfoIndex
bix <- IntMap a -> [BreakInfoIndex]
forall a. IntMap a -> [BreakInfoIndex]
IM.keys IntMap a
im
  ]

toList :: BreakpointMap a -> [(InternalBreakpointId, a)]
toList :: forall a. BreakpointMap a -> [(InternalBreakpointId, a)]
toList (BreakpointMap ModuleEnv (IntMap a)
bm) =
  [ (Module -> BreakInfoIndex -> InternalBreakpointId
InternalBreakpointId Module
m BreakInfoIndex
bix, a
a)
  | (Module
m, IntMap a
im)  <- ModuleEnv (IntMap a) -> [(Module, IntMap a)]
forall a. ModuleEnv a -> [(Module, a)]
moduleEnvToList ModuleEnv (IntMap a)
bm
  , (BreakInfoIndex
bix, a
a) <- IntMap a -> [(BreakInfoIndex, a)]
forall a. IntMap a -> [(BreakInfoIndex, a)]
IM.toList IntMap a
im
  ]

instance DebugView (BreakpointMap a) where
  debugValue :: BreakpointMap a -> VarValue
debugValue (BreakpointMap ModuleEnv (IntMap a)
b) = String -> Bool -> VarValue
simpleValue String
"BreakpointMap" (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ ModuleEnv (IntMap a) -> Bool
forall a. ModuleEnv a -> Bool
isEmptyModuleEnv ModuleEnv (IntMap a)
b)
  debugFields :: BreakpointMap a -> Program VarFields
debugFields BreakpointMap a
bm = VarFields -> Program VarFields
forall a. a -> Program a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (VarFields -> Program VarFields) -> VarFields -> Program VarFields
forall a b. (a -> b) -> a -> b
$ [(String, VarFieldValue)] -> VarFields
VarFields
    [ (Module -> String
showModule Module
ibi_info_mod String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ BreakInfoIndex -> String
forall a. Show a => a -> String
show BreakInfoIndex
ibi_info_index String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")", a -> VarFieldValue
forall a. a -> VarFieldValue
VarFieldValue a
v)
    | (InternalBreakpointId{Module
ibi_info_mod :: InternalBreakpointId -> Module
ibi_info_mod :: Module
ibi_info_mod, BreakInfoIndex
ibi_info_index :: InternalBreakpointId -> BreakInfoIndex
ibi_info_index :: BreakInfoIndex
ibi_info_index}, a
v) <- BreakpointMap a -> [(InternalBreakpointId, a)]
forall a. BreakpointMap a -> [(InternalBreakpointId, a)]
toList BreakpointMap a
bm
    ]