-- | 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 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
import GHC.Prelude
import GHC.Runtime.Eval.Utils
import GHC.Types.SrcLoc
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 (BreakIndex, RealSrcSpan)
findBreakByLine :: BreakIndex -> TickArray -> Maybe (BreakIndex, RealSrcSpan)
findBreakByLine BreakIndex
line TickArray
arr
  | Bool -> Bool
not ((BreakIndex, BreakIndex) -> BreakIndex -> Bool
forall a. Ix a => (a, a) -> a -> Bool
inRange (TickArray -> (BreakIndex, BreakIndex)
forall i e. Array i e -> (i, i)
bounds TickArray
arr) BreakIndex
line) = Maybe (BreakIndex, RealSrcSpan)
forall a. Maybe a
Nothing
  | Bool
otherwise =
    [(BreakIndex, RealSrcSpan)] -> Maybe (BreakIndex, RealSrcSpan)
forall a. [a] -> Maybe a
listToMaybe (((BreakIndex, RealSrcSpan)
 -> (BreakIndex, RealSrcSpan) -> Ordering)
-> [(BreakIndex, RealSrcSpan)] -> [(BreakIndex, RealSrcSpan)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (RealSrcSpan -> RealSrcSpan -> Ordering
leftmostLargestRealSrcSpan (RealSrcSpan -> RealSrcSpan -> Ordering)
-> ((BreakIndex, RealSrcSpan) -> RealSrcSpan)
-> (BreakIndex, RealSrcSpan)
-> (BreakIndex, RealSrcSpan)
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (BreakIndex, RealSrcSpan) -> RealSrcSpan
forall a b. (a, b) -> b
snd)  [(BreakIndex, RealSrcSpan)]
comp)   Maybe (BreakIndex, RealSrcSpan)
-> Maybe (BreakIndex, RealSrcSpan)
-> Maybe (BreakIndex, RealSrcSpan)
forall a. Maybe a -> Maybe a -> Maybe a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus`
    [(BreakIndex, RealSrcSpan)] -> Maybe (BreakIndex, RealSrcSpan)
forall a. [a] -> Maybe a
listToMaybe (((BreakIndex, RealSrcSpan)
 -> (BreakIndex, RealSrcSpan) -> Ordering)
-> [(BreakIndex, RealSrcSpan)] -> [(BreakIndex, RealSrcSpan)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (RealSrcSpan -> RealSrcSpan -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (RealSrcSpan -> RealSrcSpan -> Ordering)
-> ((BreakIndex, RealSrcSpan) -> RealSrcSpan)
-> (BreakIndex, RealSrcSpan)
-> (BreakIndex, RealSrcSpan)
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (BreakIndex, RealSrcSpan) -> RealSrcSpan
forall a b. (a, b) -> b
snd) [(BreakIndex, RealSrcSpan)]
incomp) Maybe (BreakIndex, RealSrcSpan)
-> Maybe (BreakIndex, RealSrcSpan)
-> Maybe (BreakIndex, RealSrcSpan)
forall a. Maybe a -> Maybe a -> Maybe a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus`
    [(BreakIndex, RealSrcSpan)] -> Maybe (BreakIndex, RealSrcSpan)
forall a. [a] -> Maybe a
listToMaybe (((BreakIndex, RealSrcSpan)
 -> (BreakIndex, RealSrcSpan) -> Ordering)
-> [(BreakIndex, RealSrcSpan)] -> [(BreakIndex, 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)
-> ((BreakIndex, RealSrcSpan) -> RealSrcSpan)
-> (BreakIndex, RealSrcSpan)
-> (BreakIndex, RealSrcSpan)
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (BreakIndex, RealSrcSpan) -> RealSrcSpan
forall a b. (a, b) -> b
snd) [(BreakIndex, RealSrcSpan)]
ticks)
  where
        ticks :: [(BreakIndex, RealSrcSpan)]
ticks = TickArray
arr TickArray -> BreakIndex -> [(BreakIndex, RealSrcSpan)]
forall i e. Ix i => Array i e -> i -> e
! BreakIndex
line

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

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

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

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

        after_here :: [(BreakIndex, RealSrcSpan)]
after_here = [ (BreakIndex, RealSrcSpan)
tick | tick :: (BreakIndex, RealSrcSpan)
tick@(BreakIndex
_,RealSrcSpan
pan) <- [(BreakIndex, RealSrcSpan)]
ticks,
                              RealSrcSpan -> BreakIndex
GHC.srcSpanStartLine RealSrcSpan
pan BreakIndex -> BreakIndex -> Bool
forall a. Eq a => a -> a -> Bool
== BreakIndex
line,
                              RealSrcSpan -> BreakIndex
GHC.srcSpanStartCol RealSrcSpan
pan BreakIndex -> BreakIndex -> Bool
forall a. Ord a => a -> a -> Bool
>= BreakIndex
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 ((BreakIndex, BreakIndex) -> BreakIndex -> Bool
forall a. Ix a => (a, a) -> a -> Bool
inRange (TickArray -> (BreakIndex, BreakIndex)
forall i e. Array i e -> (i, i)
bounds TickArray
ticks) BreakIndex
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 :: BreakIndex
line = RealSrcSpan -> BreakIndex
srcSpanStartLine RealSrcSpan
src
    enclosing_spans :: [RealSrcSpan]
enclosing_spans = [ RealSrcSpan
pan | (BreakIndex
_,RealSrcSpan
pan) <- TickArray
ticks TickArray -> BreakIndex -> [(BreakIndex, RealSrcSpan)]
forall i e. Ix i => Array i e -> i -> e
! BreakIndex
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)
GHC.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 :: GHC.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)
GHC.parseName String
mod_top_lvl
        pure $ Just $ NE.head $ GHC.nameModule <$> names

    -- Lookup the Module of a module name in the module graph
    lookupModuleInGraph :: GHC.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
GHC.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]
GHC.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 :: GHC.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
GHC.moduleIsInterpreted Module
modl
        (_, decls) <- getModBreak 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 -> case 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 BreakIndex [String] -> [[String]]
forall i e. Array i e -> [e]
elems Array BreakIndex [String]
decls) 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
"No breakpoint found for" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
fun_str)
                   SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"in 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)
                Bool
True  -> Maybe SDoc -> m (Maybe SDoc)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe SDoc
forall a. Maybe a
Nothing
        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 -} -> GHC.ModBreaks -> [(BreakIndex, RealSrcSpan)]
findBreakForBind :: String -> ModBreaks -> [(BreakIndex, RealSrcSpan)]
findBreakForBind String
str_name ModBreaks
modbreaks = ((BreakIndex, RealSrcSpan) -> Bool)
-> [(BreakIndex, RealSrcSpan)] -> [(BreakIndex, RealSrcSpan)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool)
-> ((BreakIndex, RealSrcSpan) -> Bool)
-> (BreakIndex, RealSrcSpan)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (BreakIndex, RealSrcSpan) -> Bool
enclosed) [(BreakIndex, RealSrcSpan)]
ticks
  where
    ticks :: [(BreakIndex, RealSrcSpan)]
ticks = [ (BreakIndex
index, RealSrcSpan
span)
            | (BreakIndex
index, [String]
decls) <- Array BreakIndex [String] -> [(BreakIndex, [String])]
forall i e. Ix i => Array i e -> [(i, e)]
assocs (ModBreaks -> Array BreakIndex [String]
GHC.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 BreakIndex SrcSpan
GHC.modBreaks_locs ModBreaks
modbreaks Array BreakIndex SrcSpan -> BreakIndex -> SrcSpan
forall i e. Ix i => Array i e -> i -> e
! BreakIndex
index] ]
    enclosed :: (BreakIndex, RealSrcSpan) -> Bool
enclosed (BreakIndex
_,RealSrcSpan
sp0) = ((BreakIndex, RealSrcSpan) -> Bool)
-> [(BreakIndex, RealSrcSpan)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (BreakIndex, RealSrcSpan) -> Bool
subspan [(BreakIndex, RealSrcSpan)]
ticks
      where subspan :: (BreakIndex, RealSrcSpan) -> Bool
subspan (BreakIndex
_,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 [(GHC.BreakIndex,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)
GHC.getModuleInfo Module
m
  return $
    mkTickArray . assocs . GHC.modBreaks_locs . GHC.modInfoModBreaks <$> mi
  where
    mkTickArray :: [(BreakIndex, SrcSpan)] -> TickArray
    mkTickArray :: [(BreakIndex, SrcSpan)] -> TickArray
mkTickArray [(BreakIndex, SrcSpan)]
ticks
      = ([(BreakIndex, RealSrcSpan)]
 -> (BreakIndex, RealSrcSpan) -> [(BreakIndex, RealSrcSpan)])
-> [(BreakIndex, RealSrcSpan)]
-> (BreakIndex, BreakIndex)
-> [(BreakIndex, (BreakIndex, RealSrcSpan))]
-> TickArray
forall i e a.
Ix i =>
(e -> a -> e) -> e -> (i, i) -> [(i, a)] -> Array i e
accumArray (((BreakIndex, RealSrcSpan)
 -> [(BreakIndex, RealSrcSpan)] -> [(BreakIndex, RealSrcSpan)])
-> [(BreakIndex, RealSrcSpan)]
-> (BreakIndex, RealSrcSpan)
-> [(BreakIndex, RealSrcSpan)]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (:)) [] (BreakIndex
1, BreakIndex
max_line)
            [ (BreakIndex
line, (BreakIndex
nm,RealSrcSpan
pan)) | (BreakIndex
nm,RealSrcSpan RealSrcSpan
pan Maybe BufSpan
_) <- [(BreakIndex, SrcSpan)]
ticks, BreakIndex
line <- RealSrcSpan -> [BreakIndex]
srcSpanLines RealSrcSpan
pan ]
        where
            max_line :: BreakIndex
max_line = (BreakIndex -> BreakIndex -> BreakIndex)
-> BreakIndex -> [BreakIndex] -> BreakIndex
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr BreakIndex -> BreakIndex -> BreakIndex
forall a. Ord a => a -> a -> a
max BreakIndex
0 [ RealSrcSpan -> BreakIndex
GHC.srcSpanEndLine RealSrcSpan
sp | (BreakIndex
_, RealSrcSpan RealSrcSpan
sp Maybe BufSpan
_) <- [(BreakIndex, SrcSpan)]
ticks ]
            srcSpanLines :: RealSrcSpan -> [BreakIndex]
srcSpanLines RealSrcSpan
pan = [ RealSrcSpan -> BreakIndex
GHC.srcSpanStartLine RealSrcSpan
pan ..  RealSrcSpan -> BreakIndex
GHC.srcSpanEndLine RealSrcSpan
pan ]

-- | Get the 'modBreaks_locs' and 'modBreaks_decls' of the given 'Module'
getModBreak :: GHC.GhcMonad m
            => Module -> m (Array Int SrcSpan, Array Int [String])
getModBreak :: forall (m :: * -> *).
GhcMonad m =>
Module -> m (Array BreakIndex SrcSpan, Array BreakIndex [String])
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)
GHC.getModuleInfo Module
m
   let modBreaks  = ModuleInfo -> ModBreaks
GHC.modInfoModBreaks ModuleInfo
mod_info
   let ticks      = ModBreaks -> Array BreakIndex SrcSpan
GHC.modBreaks_locs  ModBreaks
modBreaks
   let decls      = ModBreaks -> Array BreakIndex [String]
GHC.modBreaks_decls ModBreaks
modBreaks
   return (ticks, decls)

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

getCurrentBreakSpan :: GHC.GhcMonad m => m (Maybe SrcSpan)
getCurrentBreakSpan :: forall (m :: * -> *). GhcMonad m => m (Maybe SrcSpan)
getCurrentBreakSpan = do
  resumes <- m [Resume]
forall (m :: * -> *). GhcMonad m => m [Resume]
GHC.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 :: BreakIndex
ix = Resume -> BreakIndex
GHC.resumeHistoryIx Resume
r
        if BreakIndex
ix BreakIndex -> BreakIndex -> Bool
forall a. Eq a => a -> a -> Bool
== BreakIndex
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
GHC.resumeSpan Resume
r))
           else do
                let hist :: History
hist = Resume -> [History]
GHC.resumeHistory Resume
r [History] -> BreakIndex -> History
forall a. HasCallStack => [a] -> BreakIndex -> a
!! (BreakIndex
ixBreakIndex -> BreakIndex -> BreakIndex
forall a. Num a => a -> a -> a
-BreakIndex
1)
                pan <- History -> m SrcSpan
forall (m :: * -> *). GhcMonad m => History -> m SrcSpan
GHC.getHistorySpan History
hist
                return (Just pan)

getCurrentBreakModule :: GHC.GhcMonad m => m (Maybe Module)
getCurrentBreakModule :: forall (m :: * -> *). GhcMonad m => m (Maybe Module)
getCurrentBreakModule = do
  resumes <- m [Resume]
forall (m :: * -> *). GhcMonad m => m [Resume]
GHC.getResumeContext
  return $ case resumes of
    [] -> Maybe Module
forall a. Maybe a
Nothing
    (Resume
r:[Resume]
_) -> case Resume -> BreakIndex
GHC.resumeHistoryIx Resume
r of
      BreakIndex
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
GHC.resumeBreakpointId Resume
r
      BreakIndex
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
GHC.getHistoryModule (History -> Module) -> History -> Module
forall a b. (a -> b) -> a -> b
$ Resume -> [History]
GHC.resumeHistory Resume
r [History] -> BreakIndex -> History
forall a. HasCallStack => [a] -> BreakIndex -> a
!! (BreakIndex
ixBreakIndex -> BreakIndex -> BreakIndex
forall a. Num a => a -> a -> a
-BreakIndex
1)