-- | GHC API debugger module for finding and setting breakpoints.
--
-- This module is user facing and is at least used by `GHCi` and `ghc-debugger`
-- to find and set breakpoints.
module GHC.Runtime.Debugger.Breakpoints where

import GHC.Prelude

import Control.Monad.Catch
import Control.Monad
import Data.Array
import Data.Function
import Data.List
import Data.Maybe
import qualified Data.List.NonEmpty as NE
import qualified Data.Semigroup as S

import GHC.HsToCore.Breakpoints
import GHC.ByteCode.Breakpoints
import GHC.Driver.Env
import GHC.Driver.Monad
import GHC.Driver.Session.Inspect
import GHC.Runtime.Eval
import GHC.Runtime.Eval.Utils
import GHC.Types.Name
import GHC.Types.SrcLoc
import GHC.Unit.Module
import GHC.Unit.Module.Graph
import GHC.Unit.Module.ModSummary
import GHC.Utils.Outputable
import GHC.Utils.Panic
import qualified GHC.Data.Strict as Strict

--------------------------------------------------------------------------------
-- Finding Module breakpoints
--------------------------------------------------------------------------------

-- | Find a breakpoint given a Module's 'TickArray' and the line number.
--
-- When a line number is specified, the current policy for choosing
-- the best breakpoint is this:
--    - the leftmost complete subexpression on the specified line, or
--    - the leftmost subexpression starting on the specified line, or
--    - the rightmost subexpression enclosing the specified line
--
findBreakByLine :: Int {-^ Line number -} -> TickArray -> Maybe (BreakTickIndex, RealSrcSpan)
findBreakByLine :: BreakTickIndex -> TickArray -> Maybe (BreakTickIndex, RealSrcSpan)
findBreakByLine BreakTickIndex
line TickArray
arr
  | Bool -> Bool
not ((BreakTickIndex, BreakTickIndex) -> BreakTickIndex -> Bool
forall a. Ix a => (a, a) -> a -> Bool
inRange (TickArray -> (BreakTickIndex, BreakTickIndex)
forall i e. Array i e -> (i, i)
bounds TickArray
arr) BreakTickIndex
line) = Maybe (BreakTickIndex, RealSrcSpan)
forall a. Maybe a
Nothing
  | Bool
otherwise =
    [(BreakTickIndex, RealSrcSpan)]
-> Maybe (BreakTickIndex, RealSrcSpan)
forall a. [a] -> Maybe a
listToMaybe (((BreakTickIndex, RealSrcSpan)
 -> (BreakTickIndex, RealSrcSpan) -> Ordering)
-> [(BreakTickIndex, RealSrcSpan)]
-> [(BreakTickIndex, RealSrcSpan)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (RealSrcSpan -> RealSrcSpan -> Ordering
leftmostLargestRealSrcSpan (RealSrcSpan -> RealSrcSpan -> Ordering)
-> ((BreakTickIndex, RealSrcSpan) -> RealSrcSpan)
-> (BreakTickIndex, RealSrcSpan)
-> (BreakTickIndex, RealSrcSpan)
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (BreakTickIndex, RealSrcSpan) -> RealSrcSpan
forall a b. (a, b) -> b
snd)  [(BreakTickIndex, RealSrcSpan)]
comp)   Maybe (BreakTickIndex, RealSrcSpan)
-> Maybe (BreakTickIndex, RealSrcSpan)
-> Maybe (BreakTickIndex, RealSrcSpan)
forall a. Maybe a -> Maybe a -> Maybe a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus`
    [(BreakTickIndex, RealSrcSpan)]
-> Maybe (BreakTickIndex, RealSrcSpan)
forall a. [a] -> Maybe a
listToMaybe (((BreakTickIndex, RealSrcSpan)
 -> (BreakTickIndex, RealSrcSpan) -> Ordering)
-> [(BreakTickIndex, RealSrcSpan)]
-> [(BreakTickIndex, RealSrcSpan)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (RealSrcSpan -> RealSrcSpan -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (RealSrcSpan -> RealSrcSpan -> Ordering)
-> ((BreakTickIndex, RealSrcSpan) -> RealSrcSpan)
-> (BreakTickIndex, RealSrcSpan)
-> (BreakTickIndex, RealSrcSpan)
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (BreakTickIndex, RealSrcSpan) -> RealSrcSpan
forall a b. (a, b) -> b
snd) [(BreakTickIndex, RealSrcSpan)]
incomp) Maybe (BreakTickIndex, RealSrcSpan)
-> Maybe (BreakTickIndex, RealSrcSpan)
-> Maybe (BreakTickIndex, RealSrcSpan)
forall a. Maybe a -> Maybe a -> Maybe a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus`
    [(BreakTickIndex, RealSrcSpan)]
-> Maybe (BreakTickIndex, RealSrcSpan)
forall a. [a] -> Maybe a
listToMaybe (((BreakTickIndex, RealSrcSpan)
 -> (BreakTickIndex, RealSrcSpan) -> Ordering)
-> [(BreakTickIndex, RealSrcSpan)]
-> [(BreakTickIndex, RealSrcSpan)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy ((RealSrcSpan -> RealSrcSpan -> Ordering)
-> RealSrcSpan -> RealSrcSpan -> Ordering
forall a b c. (a -> b -> c) -> b -> a -> c
flip RealSrcSpan -> RealSrcSpan -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (RealSrcSpan -> RealSrcSpan -> Ordering)
-> ((BreakTickIndex, RealSrcSpan) -> RealSrcSpan)
-> (BreakTickIndex, RealSrcSpan)
-> (BreakTickIndex, RealSrcSpan)
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (BreakTickIndex, RealSrcSpan) -> RealSrcSpan
forall a b. (a, b) -> b
snd) [(BreakTickIndex, RealSrcSpan)]
ticks)
  where
        ticks :: [(BreakTickIndex, RealSrcSpan)]
ticks = TickArray
arr TickArray -> BreakTickIndex -> [(BreakTickIndex, RealSrcSpan)]
forall i e. Ix i => Array i e -> i -> e
! BreakTickIndex
line

        starts_here :: [(BreakTickIndex, RealSrcSpan)]
starts_here = [ (BreakTickIndex
ix,RealSrcSpan
pan) | (BreakTickIndex
ix, RealSrcSpan
pan) <- [(BreakTickIndex, RealSrcSpan)]
ticks,
                        RealSrcSpan -> BreakTickIndex
srcSpanStartLine RealSrcSpan
pan BreakTickIndex -> BreakTickIndex -> Bool
forall a. Eq a => a -> a -> Bool
== BreakTickIndex
line ]

        ([(BreakTickIndex, RealSrcSpan)]
comp, [(BreakTickIndex, RealSrcSpan)]
incomp) = ((BreakTickIndex, RealSrcSpan) -> Bool)
-> [(BreakTickIndex, RealSrcSpan)]
-> ([(BreakTickIndex, RealSrcSpan)],
    [(BreakTickIndex, RealSrcSpan)])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (BreakTickIndex, RealSrcSpan) -> Bool
ends_here [(BreakTickIndex, RealSrcSpan)]
starts_here
            where ends_here :: (BreakTickIndex, RealSrcSpan) -> Bool
ends_here (BreakTickIndex
_,RealSrcSpan
pan) = RealSrcSpan -> BreakTickIndex
srcSpanEndLine RealSrcSpan
pan BreakTickIndex -> BreakTickIndex -> Bool
forall a. Eq a => a -> a -> Bool
== BreakTickIndex
line

-- | Find a breakpoint in the 'TickArray' of a module, given a line number and a column coordinate.
findBreakByCoord :: (Int, Int) -> TickArray -> Maybe (BreakTickIndex, RealSrcSpan)
findBreakByCoord :: (BreakTickIndex, BreakTickIndex)
-> TickArray -> Maybe (BreakTickIndex, RealSrcSpan)
findBreakByCoord (BreakTickIndex
line, BreakTickIndex
col) TickArray
arr
  | Bool -> Bool
not ((BreakTickIndex, BreakTickIndex) -> BreakTickIndex -> Bool
forall a. Ix a => (a, a) -> a -> Bool
inRange (TickArray -> (BreakTickIndex, BreakTickIndex)
forall i e. Array i e -> (i, i)
bounds TickArray
arr) BreakTickIndex
line) = Maybe (BreakTickIndex, RealSrcSpan)
forall a. Maybe a
Nothing
  | Bool
otherwise =
    [(BreakTickIndex, RealSrcSpan)]
-> Maybe (BreakTickIndex, RealSrcSpan)
forall a. [a] -> Maybe a
listToMaybe (((BreakTickIndex, RealSrcSpan)
 -> (BreakTickIndex, RealSrcSpan) -> Ordering)
-> [(BreakTickIndex, RealSrcSpan)]
-> [(BreakTickIndex, RealSrcSpan)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy ((RealSrcSpan -> RealSrcSpan -> Ordering)
-> RealSrcSpan -> RealSrcSpan -> Ordering
forall a b c. (a -> b -> c) -> b -> a -> c
flip RealSrcSpan -> RealSrcSpan -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (RealSrcSpan -> RealSrcSpan -> Ordering)
-> ((BreakTickIndex, RealSrcSpan) -> RealSrcSpan)
-> (BreakTickIndex, RealSrcSpan)
-> (BreakTickIndex, RealSrcSpan)
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (BreakTickIndex, RealSrcSpan) -> RealSrcSpan
forall a b. (a, b) -> b
snd) [(BreakTickIndex, RealSrcSpan)]
contains [(BreakTickIndex, RealSrcSpan)]
-> [(BreakTickIndex, RealSrcSpan)]
-> [(BreakTickIndex, RealSrcSpan)]
forall a. [a] -> [a] -> [a]
++
                 ((BreakTickIndex, RealSrcSpan)
 -> (BreakTickIndex, RealSrcSpan) -> Ordering)
-> [(BreakTickIndex, RealSrcSpan)]
-> [(BreakTickIndex, RealSrcSpan)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (RealSrcSpan -> RealSrcSpan -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (RealSrcSpan -> RealSrcSpan -> Ordering)
-> ((BreakTickIndex, RealSrcSpan) -> RealSrcSpan)
-> (BreakTickIndex, RealSrcSpan)
-> (BreakTickIndex, RealSrcSpan)
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (BreakTickIndex, RealSrcSpan) -> RealSrcSpan
forall a b. (a, b) -> b
snd) [(BreakTickIndex, RealSrcSpan)]
after_here)
  where
        ticks :: [(BreakTickIndex, RealSrcSpan)]
ticks = TickArray
arr TickArray -> BreakTickIndex -> [(BreakTickIndex, RealSrcSpan)]
forall i e. Ix i => Array i e -> i -> e
! BreakTickIndex
line

        -- the ticks that span this coordinate
        contains :: [(BreakTickIndex, RealSrcSpan)]
contains = [ (BreakTickIndex, RealSrcSpan)
tick | tick :: (BreakTickIndex, RealSrcSpan)
tick@(BreakTickIndex
_,RealSrcSpan
pan) <- [(BreakTickIndex, RealSrcSpan)]
ticks, RealSrcSpan -> Maybe BufSpan -> SrcSpan
RealSrcSpan RealSrcSpan
pan Maybe BufSpan
forall a. Maybe a
Strict.Nothing SrcSpan -> (BreakTickIndex, BreakTickIndex) -> Bool
`spans` (BreakTickIndex
line,BreakTickIndex
col) ]

        after_here :: [(BreakTickIndex, RealSrcSpan)]
after_here = [ (BreakTickIndex, RealSrcSpan)
tick | tick :: (BreakTickIndex, RealSrcSpan)
tick@(BreakTickIndex
_,RealSrcSpan
pan) <- [(BreakTickIndex, RealSrcSpan)]
ticks,
                              RealSrcSpan -> BreakTickIndex
srcSpanStartLine RealSrcSpan
pan BreakTickIndex -> BreakTickIndex -> Bool
forall a. Eq a => a -> a -> Bool
== BreakTickIndex
line,
                              RealSrcSpan -> BreakTickIndex
srcSpanStartCol RealSrcSpan
pan BreakTickIndex -> BreakTickIndex -> Bool
forall a. Ord a => a -> a -> Bool
>= BreakTickIndex
col ]

leftmostLargestRealSrcSpan :: RealSrcSpan -> RealSrcSpan -> Ordering
leftmostLargestRealSrcSpan :: RealSrcSpan -> RealSrcSpan -> Ordering
leftmostLargestRealSrcSpan = (RealSrcLoc -> RealSrcLoc -> Ordering)
-> (RealSrcSpan -> RealSrcLoc)
-> RealSrcSpan
-> RealSrcSpan
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
on RealSrcLoc -> RealSrcLoc -> Ordering
forall a. Ord a => a -> a -> Ordering
compare RealSrcSpan -> RealSrcLoc
realSrcSpanStart (RealSrcSpan -> RealSrcSpan -> Ordering)
-> (RealSrcSpan -> RealSrcSpan -> Ordering)
-> RealSrcSpan
-> RealSrcSpan
-> Ordering
forall a. Semigroup a => a -> a -> a
S.<> (RealSrcLoc -> RealSrcLoc -> Ordering)
-> (RealSrcSpan -> RealSrcLoc)
-> RealSrcSpan
-> RealSrcSpan
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
on ((RealSrcLoc -> RealSrcLoc -> Ordering)
-> RealSrcLoc -> RealSrcLoc -> Ordering
forall a b c. (a -> b -> c) -> b -> a -> c
flip RealSrcLoc -> RealSrcLoc -> Ordering
forall a. Ord a => a -> a -> Ordering
compare) RealSrcSpan -> RealSrcLoc
realSrcSpanEnd

-- | Returns the span of the largest tick containing the srcspan given
enclosingTickSpan :: TickArray -> SrcSpan -> RealSrcSpan
enclosingTickSpan :: TickArray -> SrcSpan -> RealSrcSpan
enclosingTickSpan TickArray
_ (UnhelpfulSpan UnhelpfulSpanReason
_) = String -> RealSrcSpan
forall a. HasCallStack => String -> a
panic String
"enclosingTickSpan UnhelpfulSpan"
enclosingTickSpan TickArray
ticks (RealSrcSpan RealSrcSpan
src Maybe BufSpan
_) =
  Bool -> RealSrcSpan -> RealSrcSpan
forall a. HasCallStack => Bool -> a -> a
assert ((BreakTickIndex, BreakTickIndex) -> BreakTickIndex -> Bool
forall a. Ix a => (a, a) -> a -> Bool
inRange (TickArray -> (BreakTickIndex, BreakTickIndex)
forall i e. Array i e -> (i, i)
bounds TickArray
ticks) BreakTickIndex
line) (RealSrcSpan -> RealSrcSpan) -> RealSrcSpan -> RealSrcSpan
forall a b. (a -> b) -> a -> b
$
    (RealSrcSpan -> RealSrcSpan -> Ordering)
-> [RealSrcSpan] -> RealSrcSpan
forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
Data.List.minimumBy RealSrcSpan -> RealSrcSpan -> Ordering
leftmostLargestRealSrcSpan ([RealSrcSpan] -> RealSrcSpan) -> [RealSrcSpan] -> RealSrcSpan
forall a b. (a -> b) -> a -> b
$ [RealSrcSpan]
enclosing_spans
  where
    line :: BreakTickIndex
line = RealSrcSpan -> BreakTickIndex
srcSpanStartLine RealSrcSpan
src
    enclosing_spans :: [RealSrcSpan]
enclosing_spans = [ RealSrcSpan
pan | (BreakTickIndex
_,RealSrcSpan
pan) <- TickArray
ticks TickArray -> BreakTickIndex -> [(BreakTickIndex, RealSrcSpan)]
forall i e. Ix i => Array i e -> i -> e
! BreakTickIndex
line
                            , RealSrcSpan -> RealSrcLoc
realSrcSpanEnd RealSrcSpan
pan RealSrcLoc -> RealSrcLoc -> Bool
forall a. Ord a => a -> a -> Bool
>= RealSrcSpan -> RealSrcLoc
realSrcSpanEnd RealSrcSpan
src]

--------------------------------------------------------------------------------
-- Finding Function breakpoints
--------------------------------------------------------------------------------

-- | Process and validate the user string of form @[Module.]function@ into the
-- relevant module information and function name.
--
-- Validation guarantees
--  1. The module exists
--  2. The identifier is in an interpreted module
--  3. The identifier has a breakpoint entry in the module's 'ModBreaks'
--
-- Returns either an error SDoc or the 'Module' and 'ModuleInfo' for the relevant module
-- paired with the function name
--
-- See also Note [Setting Breakpoints by Id]
resolveFunctionBreakpoint :: GhcMonad m => String -> m (Either SDoc (Module, ModuleInfo, String))
resolveFunctionBreakpoint :: forall (m :: * -> *).
GhcMonad m =>
String -> m (Either SDoc (Module, ModuleInfo, String))
resolveFunctionBreakpoint String
inp = do
  let (String
mod_str, String
top_level, String
fun_str) = String -> (String, String, String)
splitIdent String
inp
      mod_top_lvl :: String
mod_top_lvl = String -> String -> String
combineModIdent String
mod_str String
top_level
  mb_mod <- m (Maybe Module)
-> (SomeException -> m (Maybe Module)) -> m (Maybe Module)
forall e a. (HasCallStack, Exception e) => m a -> (e -> m a) -> m a
forall (m :: * -> *) e a.
(MonadCatch m, HasCallStack, Exception e) =>
m a -> (e -> m a) -> m a
catch (String -> m (Maybe Module)
forall (m :: * -> *). GhcMonad m => String -> m (Maybe Module)
lookupModuleInscope String
mod_top_lvl)
                  (\(SomeException
_ :: SomeException) -> String -> m (Maybe Module)
forall (m :: * -> *). GhcMonad m => String -> m (Maybe Module)
lookupModuleInGraph String
mod_str)
    -- If the top-level name is not in scope, `lookupModuleInscope` will
    -- throw an exception, then lookup the module name in the module graph.
  mb_err_msg <- validateBP mod_str fun_str mb_mod
  case mb_err_msg of
    Just SDoc
err_msg -> Either SDoc (Module, ModuleInfo, String)
-> m (Either SDoc (Module, ModuleInfo, String))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either SDoc (Module, ModuleInfo, String)
 -> m (Either SDoc (Module, ModuleInfo, String)))
-> (SDoc -> Either SDoc (Module, ModuleInfo, String))
-> SDoc
-> m (Either SDoc (Module, ModuleInfo, String))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SDoc -> Either SDoc (Module, ModuleInfo, String)
forall a b. a -> Either a b
Left (SDoc -> m (Either SDoc (Module, ModuleInfo, String)))
-> SDoc -> m (Either SDoc (Module, ModuleInfo, String))
forall a b. (a -> b) -> a -> b
$
      String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Cannot set breakpoint on" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
inp)
      SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
":" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
err_msg
    Maybe SDoc
Nothing -> do
      -- No errors found, go and return the module info
      let mod :: Module
mod = Module -> Maybe Module -> Module
forall a. a -> Maybe a -> a
fromMaybe (String -> Module
forall a. HasCallStack => String -> a
panic String
"resolveFunctionBreakpoint") Maybe Module
mb_mod
      mb_mod_info  <- Module -> m (Maybe ModuleInfo)
forall (m :: * -> *). GhcMonad m => Module -> m (Maybe ModuleInfo)
getModuleInfo Module
mod
      case mb_mod_info of
        Maybe ModuleInfo
Nothing -> Either SDoc (Module, ModuleInfo, String)
-> m (Either SDoc (Module, ModuleInfo, String))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either SDoc (Module, ModuleInfo, String)
 -> m (Either SDoc (Module, ModuleInfo, String)))
-> (SDoc -> Either SDoc (Module, ModuleInfo, String))
-> SDoc
-> m (Either SDoc (Module, ModuleInfo, String))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SDoc -> Either SDoc (Module, ModuleInfo, String)
forall a b. a -> Either a b
Left (SDoc -> m (Either SDoc (Module, ModuleInfo, String)))
-> SDoc -> m (Either SDoc (Module, ModuleInfo, String))
forall a b. (a -> b) -> a -> b
$
          String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Could not find ModuleInfo of " SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> Module -> SDoc
forall a. Outputable a => a -> SDoc
ppr Module
mod
        Just ModuleInfo
mod_info -> Either SDoc (Module, ModuleInfo, String)
-> m (Either SDoc (Module, ModuleInfo, String))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either SDoc (Module, ModuleInfo, String)
 -> m (Either SDoc (Module, ModuleInfo, String)))
-> Either SDoc (Module, ModuleInfo, String)
-> m (Either SDoc (Module, ModuleInfo, String))
forall a b. (a -> b) -> a -> b
$ (Module, ModuleInfo, String)
-> Either SDoc (Module, ModuleInfo, String)
forall a b. b -> Either a b
Right (Module
mod, ModuleInfo
mod_info, String
fun_str)
  where
    -- Try to lookup the module for an identifier that is in scope.
    -- `parseName` throws an exception, if the identifier is not in scope
    lookupModuleInscope :: GhcMonad m => String -> m (Maybe Module)
    lookupModuleInscope :: forall (m :: * -> *). GhcMonad m => String -> m (Maybe Module)
lookupModuleInscope String
mod_top_lvl = do
        names <- String -> m (NonEmpty Name)
forall (m :: * -> *). GhcMonad m => String -> m (NonEmpty Name)
parseName String
mod_top_lvl
        pure $ Just $ NE.head $ nameModule <$> names

    -- Lookup the Module of a module name in the module graph
    lookupModuleInGraph :: GhcMonad m => String -> m (Maybe Module)
    lookupModuleInGraph :: forall (m :: * -> *). GhcMonad m => String -> m (Maybe Module)
lookupModuleInGraph String
mod_str = do
        graph <- m ModuleGraph
forall (m :: * -> *). GhcMonad m => m ModuleGraph
getModuleGraph
        let hmods = ModSummary -> Module
ms_mod (ModSummary -> Module) -> [ModSummary] -> [Module]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ModuleGraph -> [ModSummary]
mgModSummaries ModuleGraph
graph
        pure $ find ((== mod_str) . moduleNameString . moduleName) hmods

    -- Check validity of an identifier to set a breakpoint:
    --  1. The module of the identifier must exist
    --  2. the identifier must be in an interpreted module
    --  3. the ModBreaks array for module `mod` must have an entry
    --     for the function
    validateBP :: GhcMonad m => String -> String -> Maybe Module
                       -> m (Maybe SDoc)
    validateBP :: forall (m :: * -> *).
GhcMonad m =>
String -> String -> Maybe Module -> m (Maybe SDoc)
validateBP String
mod_str String
fun_str Maybe Module
Nothing = Maybe SDoc -> m (Maybe SDoc)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe SDoc -> m (Maybe SDoc)) -> Maybe SDoc -> m (Maybe SDoc)
forall a b. (a -> b) -> a -> b
$ SDoc -> Maybe SDoc
forall a. a -> Maybe a
Just (SDoc -> Maybe SDoc) -> SDoc -> Maybe SDoc
forall a b. (a -> b) -> a -> b
$ SDoc -> SDoc
quotes (String -> SDoc
forall doc. IsLine doc => String -> doc
text
        (String -> String -> String
combineModIdent String
mod_str ((Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'.') String
fun_str)))
        SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"not in scope"
    validateBP String
_ String
"" (Just Module
_) = Maybe SDoc -> m (Maybe SDoc)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe SDoc -> m (Maybe SDoc)) -> Maybe SDoc -> m (Maybe SDoc)
forall a b. (a -> b) -> a -> b
$ SDoc -> Maybe SDoc
forall a. a -> Maybe a
Just (SDoc -> Maybe SDoc) -> SDoc -> Maybe SDoc
forall a b. (a -> b) -> a -> b
$ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Function name is missing"
    validateBP String
_ String
fun_str (Just Module
modl) = do
        isInterpr <- Module -> m Bool
forall (m :: * -> *). GhcMonad m => Module -> m Bool
moduleIsInterpreted Module
modl
        mb_err_msg <- case isInterpr of
          Bool
False -> Maybe SDoc -> m (Maybe SDoc)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe SDoc -> m (Maybe SDoc)) -> Maybe SDoc -> m (Maybe SDoc)
forall a b. (a -> b) -> a -> b
$ SDoc -> Maybe SDoc
forall a. a -> Maybe a
Just (SDoc -> Maybe SDoc) -> SDoc -> Maybe SDoc
forall a b. (a -> b) -> a -> b
$ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Module" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Module -> SDoc
forall a. Outputable a => a -> SDoc
ppr Module
modl) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"is not interpreted"
          Bool
True -> do
            mb_modbreaks <- Module -> m (Maybe ModBreaks)
forall (m :: * -> *). GhcMonad m => Module -> m (Maybe ModBreaks)
getModBreak Module
modl
            let found = case Maybe ModBreaks
mb_modbreaks of
                  Maybe ModBreaks
Nothing -> Bool
False
                  Just ModBreaks
mb -> String
fun_str String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"." ([String] -> String) -> [[String]] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Array BreakTickIndex [String] -> [[String]]
forall i e. Array i e -> [e]
elems (ModBreaks -> Array BreakTickIndex [String]
modBreaks_decls ModBreaks
mb))
            if found
              then pure Nothing
              else pure $ Just $ text "No breakpoint found for" <+> quotes (text fun_str)
                                  <+> text "in module" <+> quotes (ppr modl)
        pure mb_err_msg

-- | The aim of this function is to find the breakpoints for all the RHSs of
-- the equations corresponding to a binding. So we find all breakpoints
-- for
--   (a) this binder only (it maybe a top-level or a nested declaration)
--   (b) that do not have an enclosing breakpoint
findBreakForBind :: String {-^ Name of bind to break at -} -> ModBreaks -> [(BreakTickIndex, RealSrcSpan)]
findBreakForBind :: String -> ModBreaks -> [(BreakTickIndex, RealSrcSpan)]
findBreakForBind String
str_name ModBreaks
modbreaks = ((BreakTickIndex, RealSrcSpan) -> Bool)
-> [(BreakTickIndex, RealSrcSpan)]
-> [(BreakTickIndex, RealSrcSpan)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool)
-> ((BreakTickIndex, RealSrcSpan) -> Bool)
-> (BreakTickIndex, RealSrcSpan)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (BreakTickIndex, RealSrcSpan) -> Bool
enclosed) [(BreakTickIndex, RealSrcSpan)]
ticks
  where
    ticks :: [(BreakTickIndex, RealSrcSpan)]
ticks = [ (BreakTickIndex
index, RealSrcSpan
span)
            | (BreakTickIndex
index, [String]
decls) <- Array BreakTickIndex [String] -> [(BreakTickIndex, [String])]
forall i e. Ix i => Array i e -> [(i, e)]
assocs (ModBreaks -> Array BreakTickIndex [String]
modBreaks_decls ModBreaks
modbreaks),
              String
str_name String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"." [String]
decls,
              RealSrcSpan RealSrcSpan
span Maybe BufSpan
_ <- [ModBreaks -> Array BreakTickIndex SrcSpan
modBreaks_locs ModBreaks
modbreaks Array BreakTickIndex SrcSpan -> BreakTickIndex -> SrcSpan
forall i e. Ix i => Array i e -> i -> e
! BreakTickIndex
index] ]
    enclosed :: (BreakTickIndex, RealSrcSpan) -> Bool
enclosed (BreakTickIndex
_,RealSrcSpan
sp0) = ((BreakTickIndex, RealSrcSpan) -> Bool)
-> [(BreakTickIndex, RealSrcSpan)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (BreakTickIndex, RealSrcSpan) -> Bool
subspan [(BreakTickIndex, RealSrcSpan)]
ticks
      where subspan :: (BreakTickIndex, RealSrcSpan) -> Bool
subspan (BreakTickIndex
_,RealSrcSpan
sp) = RealSrcSpan
sp RealSrcSpan -> RealSrcSpan -> Bool
forall a. Eq a => a -> a -> Bool
/= RealSrcSpan
sp0 Bool -> Bool -> Bool
&&
                         RealSrcSpan -> RealSrcLoc
realSrcSpanStart RealSrcSpan
sp RealSrcLoc -> RealSrcLoc -> Bool
forall a. Ord a => a -> a -> Bool
<= RealSrcSpan -> RealSrcLoc
realSrcSpanStart RealSrcSpan
sp0 Bool -> Bool -> Bool
&&
                         RealSrcSpan -> RealSrcLoc
realSrcSpanEnd RealSrcSpan
sp0 RealSrcLoc -> RealSrcLoc -> Bool
forall a. Ord a => a -> a -> Bool
<= RealSrcSpan -> RealSrcLoc
realSrcSpanEnd RealSrcSpan
sp

--------------------------------------------------------------------------------
-- Mapping line numbers to ticks
--------------------------------------------------------------------------------

-- | Maps line numbers to the breakpoint ticks existing at that line for a module.
type TickArray = Array Int [(BreakTickIndex,RealSrcSpan)]

-- | Construct the 'TickArray' for the given module.
makeModuleLineMap :: GhcMonad m => Module -> m (Maybe TickArray)
makeModuleLineMap :: forall (m :: * -> *). GhcMonad m => Module -> m (Maybe TickArray)
makeModuleLineMap Module
m = do
  mi <- Module -> m (Maybe ModuleInfo)
forall (m :: * -> *). GhcMonad m => Module -> m (Maybe ModuleInfo)
getModuleInfo Module
m
  return $ mkTickArray . assocs . modBreaks_locs . imodBreaks_modBreaks <$> (modInfoModBreaks =<< mi)
  where
    mkTickArray :: [(BreakTickIndex, SrcSpan)] -> TickArray
    mkTickArray :: [(BreakTickIndex, SrcSpan)] -> TickArray
mkTickArray [(BreakTickIndex, SrcSpan)]
ticks
      = ([(BreakTickIndex, RealSrcSpan)]
 -> (BreakTickIndex, RealSrcSpan)
 -> [(BreakTickIndex, RealSrcSpan)])
-> [(BreakTickIndex, RealSrcSpan)]
-> (BreakTickIndex, BreakTickIndex)
-> [(BreakTickIndex, (BreakTickIndex, RealSrcSpan))]
-> TickArray
forall i e a.
Ix i =>
(e -> a -> e) -> e -> (i, i) -> [(i, a)] -> Array i e
accumArray (((BreakTickIndex, RealSrcSpan)
 -> [(BreakTickIndex, RealSrcSpan)]
 -> [(BreakTickIndex, RealSrcSpan)])
-> [(BreakTickIndex, RealSrcSpan)]
-> (BreakTickIndex, RealSrcSpan)
-> [(BreakTickIndex, RealSrcSpan)]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (:)) [] (BreakTickIndex
1, BreakTickIndex
max_line)
            [ (BreakTickIndex
line, (BreakTickIndex
nm,RealSrcSpan
pan)) | (BreakTickIndex
nm,RealSrcSpan RealSrcSpan
pan Maybe BufSpan
_) <- [(BreakTickIndex, SrcSpan)]
ticks, BreakTickIndex
line <- RealSrcSpan -> [BreakTickIndex]
srcSpanLines RealSrcSpan
pan ]
        where
            max_line :: BreakTickIndex
max_line = (BreakTickIndex -> BreakTickIndex -> BreakTickIndex)
-> BreakTickIndex -> [BreakTickIndex] -> BreakTickIndex
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr BreakTickIndex -> BreakTickIndex -> BreakTickIndex
forall a. Ord a => a -> a -> a
max BreakTickIndex
0 [ RealSrcSpan -> BreakTickIndex
srcSpanEndLine RealSrcSpan
sp | (BreakTickIndex
_, RealSrcSpan RealSrcSpan
sp Maybe BufSpan
_) <- [(BreakTickIndex, SrcSpan)]
ticks ]
            srcSpanLines :: RealSrcSpan -> [BreakTickIndex]
srcSpanLines RealSrcSpan
pan = [ RealSrcSpan -> BreakTickIndex
srcSpanStartLine RealSrcSpan
pan ..  RealSrcSpan -> BreakTickIndex
srcSpanEndLine RealSrcSpan
pan ]

-- | Get the 'ModBreaks' of the given 'Module' when available
getModBreak :: GhcMonad m => Module -> m (Maybe ModBreaks)
getModBreak :: forall (m :: * -> *). GhcMonad m => Module -> m (Maybe ModBreaks)
getModBreak Module
m = do
   mod_info <- ModuleInfo -> Maybe ModuleInfo -> ModuleInfo
forall a. a -> Maybe a -> a
fromMaybe (String -> ModuleInfo
forall a. HasCallStack => String -> a
panic String
"getModBreak") (Maybe ModuleInfo -> ModuleInfo)
-> m (Maybe ModuleInfo) -> m ModuleInfo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Module -> m (Maybe ModuleInfo)
forall (m :: * -> *). GhcMonad m => Module -> m (Maybe ModuleInfo)
getModuleInfo Module
m
   pure $ imodBreaks_modBreaks <$> modInfoModBreaks mod_info

--------------------------------------------------------------------------------
-- Getting current breakpoint information
--------------------------------------------------------------------------------

getCurrentBreakSpan :: GhcMonad m => m (Maybe SrcSpan)
getCurrentBreakSpan :: forall (m :: * -> *). GhcMonad m => m (Maybe SrcSpan)
getCurrentBreakSpan = do
  hug <- HscEnv -> HomeUnitGraph
hsc_HUG (HscEnv -> HomeUnitGraph) -> m HscEnv -> m HomeUnitGraph
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m HscEnv
forall (m :: * -> *). GhcMonad m => m HscEnv
getSession
  resumes <- getResumeContext
  case resumes of
    [] -> Maybe SrcSpan -> m (Maybe SrcSpan)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe SrcSpan
forall a. Maybe a
Nothing
    (Resume
r:[Resume]
_) -> do
        let ix :: BreakTickIndex
ix = Resume -> BreakTickIndex
resumeHistoryIx Resume
r
        if BreakTickIndex
ix BreakTickIndex -> BreakTickIndex -> Bool
forall a. Eq a => a -> a -> Bool
== BreakTickIndex
0
           then Maybe SrcSpan -> m (Maybe SrcSpan)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcSpan -> Maybe SrcSpan
forall a. a -> Maybe a
Just (Resume -> SrcSpan
resumeSpan Resume
r))
           else do
                let hist :: History
hist = Resume -> [History]
resumeHistory Resume
r [History] -> BreakTickIndex -> History
forall a. HasCallStack => [a] -> BreakTickIndex -> a
!! (BreakTickIndex
ixBreakTickIndex -> BreakTickIndex -> BreakTickIndex
forall a. Num a => a -> a -> a
-BreakTickIndex
1)
                pan <- IO SrcSpan -> m SrcSpan
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SrcSpan -> m SrcSpan) -> IO SrcSpan -> m SrcSpan
forall a b. (a -> b) -> a -> b
$ HomeUnitGraph -> History -> IO SrcSpan
getHistorySpan HomeUnitGraph
hug History
hist
                return (Just pan)

getCurrentBreakModule :: GhcMonad m => m (Maybe Module)
getCurrentBreakModule :: forall (m :: * -> *). GhcMonad m => m (Maybe Module)
getCurrentBreakModule = do
  resumes <- m [Resume]
forall (m :: * -> *). GhcMonad m => m [Resume]
getResumeContext
  return $ case resumes of
    [] -> Maybe Module
forall a. Maybe a
Nothing
    (Resume
r:[Resume]
_) -> case Resume -> BreakTickIndex
resumeHistoryIx Resume
r of
      BreakTickIndex
0  -> InternalBreakpointId -> Module
ibi_tick_mod (InternalBreakpointId -> Module)
-> Maybe InternalBreakpointId -> Maybe Module
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Resume -> Maybe InternalBreakpointId
resumeBreakpointId Resume
r
      BreakTickIndex
ix -> Module -> Maybe Module
forall a. a -> Maybe a
Just (Module -> Maybe Module) -> Module -> Maybe Module
forall a b. (a -> b) -> a -> b
$ History -> Module
getHistoryModule (History -> Module) -> History -> Module
forall a b. (a -> b) -> a -> b
$ Resume -> [History]
resumeHistory Resume
r [History] -> BreakTickIndex -> History
forall a. HasCallStack => [a] -> BreakTickIndex -> a
!! (BreakTickIndex
ixBreakTickIndex -> BreakTickIndex -> BreakTickIndex
forall a. Num a => a -> a -> a
-BreakTickIndex
1)