    module GHC.RTS.Events.Analysis.SparkThread
      ( SparkThreadState (..)
      , sparkThreadMachine
      , capabilitySparkThreadMachine
      , capabilitySparkThreadIndexer
      )
     where

    import GHC.RTS.Events
    import GHC.RTS.Events.Analysis

    import Data.Map (Map)
    import qualified Data.Map as M
    import Data.Set (Set)
    import qualified Data.Set as S

    data SparkThreadState
      = SparkThreadInitial
      | SparkThreadCreated
      | SparkThreadRunning Int
      | SparkThreadPaused Int
      | SparkThreadFinal
      deriving (SparkThreadState -> SparkThreadState -> Bool
    (SparkThreadState -> SparkThreadState -> Bool)
    -> (SparkThreadState -> SparkThreadState -> Bool)
    -> Eq SparkThreadState
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: SparkThreadState -> SparkThreadState -> Bool
    == :: SparkThreadState -> SparkThreadState -> Bool
    $c/= :: SparkThreadState -> SparkThreadState -> Bool
    /= :: SparkThreadState -> SparkThreadState -> Bool
    Eq, Eq SparkThreadState
    Eq SparkThreadState =>
    (SparkThreadState -> SparkThreadState -> Ordering)
    -> (SparkThreadState -> SparkThreadState -> Bool)
    -> (SparkThreadState -> SparkThreadState -> Bool)
    -> (SparkThreadState -> SparkThreadState -> Bool)
    -> (SparkThreadState -> SparkThreadState -> Bool)
    -> (SparkThreadState -> SparkThreadState -> SparkThreadState)
    -> (SparkThreadState -> SparkThreadState -> SparkThreadState)
    -> Ord SparkThreadState
    SparkThreadState -> SparkThreadState -> Bool
    SparkThreadState -> SparkThreadState -> Ordering
    SparkThreadState -> SparkThreadState -> SparkThreadState
    forall a.
    Eq a =>
    (a -> a -> Ordering)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> a)
    -> (a -> a -> a)
    -> Ord a
    $ccompare :: SparkThreadState -> SparkThreadState -> Ordering
    compare :: SparkThreadState -> SparkThreadState -> Ordering
    $c< :: SparkThreadState -> SparkThreadState -> Bool
    < :: SparkThreadState -> SparkThreadState -> Bool
    $c<= :: SparkThreadState -> SparkThreadState -> Bool
    <= :: SparkThreadState -> SparkThreadState -> Bool
    $c> :: SparkThreadState -> SparkThreadState -> Bool
    > :: SparkThreadState -> SparkThreadState -> Bool
    $c>= :: SparkThreadState -> SparkThreadState -> Bool
    >= :: SparkThreadState -> SparkThreadState -> Bool
    $cmax :: SparkThreadState -> SparkThreadState -> SparkThreadState
    max :: SparkThreadState -> SparkThreadState -> SparkThreadState
    $cmin :: SparkThreadState -> SparkThreadState -> SparkThreadState
    min :: SparkThreadState -> SparkThreadState -> SparkThreadState
    Ord, Int -> SparkThreadState -> ShowS
    [SparkThreadState] -> ShowS
    SparkThreadState -> String
    (Int -> SparkThreadState -> ShowS)
    -> (SparkThreadState -> String)
    -> ([SparkThreadState] -> ShowS)
    -> Show SparkThreadState
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> SparkThreadState -> ShowS
    showsPrec :: Int -> SparkThreadState -> ShowS
    $cshow :: SparkThreadState -> String
    show :: SparkThreadState -> String
    $cshowList :: [SparkThreadState] -> ShowS
    showList :: [SparkThreadState] -> ShowS
    Show)

    sparkThreadMachine :: Machine SparkThreadState EventInfo
    sparkThreadMachine :: Machine SparkThreadState EventInfo
    sparkThreadMachine = Machine
      { initial :: SparkThreadState
    initial = SparkThreadState
    SparkThreadInitial
      , final :: SparkThreadState -> Bool
    final   = SparkThreadState -> Bool
    sparkThreadFinal
      , alpha :: EventInfo -> Bool
    alpha   = EventInfo -> Bool
    sparkThreadAlpha
      , delta :: SparkThreadState -> EventInfo -> Maybe SparkThreadState
    delta   = SparkThreadState -> EventInfo -> Maybe SparkThreadState
    sparkThreadDelta
      }
     where
      sparkThreadFinal :: SparkThreadState -> Bool
    sparkThreadFinal SparkThreadState
    SparkThreadFinal = Bool
    True
      sparkThreadFinal SparkThreadState
    _                = Bool
    False

      -- sparkThreadAlpha (CreateSparkThread _) = True
      sparkThreadAlpha :: EventInfo -> Bool
    sparkThreadAlpha (RunThread ThreadId
    _)         = Bool
    True
      sparkThreadAlpha (StopThread ThreadId
    _ ThreadStopStatus
    _)      = Bool
    True
      sparkThreadAlpha EventInfo
    SparkRun              = Bool
    True
      sparkThreadAlpha (SparkSteal Int
    _)        = Bool
    True
      sparkThreadAlpha EventInfo
    _                     = Bool
    False

      -- SparkThreadInitial
      -- sparkThreadDelta SparkThreadInitial (CreateSparkThread _) = Just SparkThreadInitial
      sparkThreadDelta :: SparkThreadState -> EventInfo -> Maybe SparkThreadState
    sparkThreadDelta SparkThreadState
    SparkThreadInitial (RunThread ThreadId
    _)         = SparkThreadState -> Maybe SparkThreadState
    forall a. a -> Maybe a
    Just SparkThreadState
    SparkThreadCreated
      -- SparkThreadCreated
      sparkThreadDelta SparkThreadState
    SparkThreadCreated EventInfo
    SparkRun                      = SparkThreadState -> Maybe SparkThreadState
    forall a. a -> Maybe a
    Just (Int -> SparkThreadState
    SparkThreadRunning Int
    0)
      sparkThreadDelta SparkThreadState
    SparkThreadCreated (SparkSteal Int
    _)                = SparkThreadState -> Maybe SparkThreadState
    forall a. a -> Maybe a
    Just (Int -> SparkThreadState
    SparkThreadRunning Int
    0)
      sparkThreadDelta SparkThreadState
    SparkThreadCreated (StopThread ThreadId
    _ ThreadStopStatus
    ThreadFinished) = SparkThreadState -> Maybe SparkThreadState
    forall a. a -> Maybe a
    Just SparkThreadState
    SparkThreadFinal
      -- SparkThreadRunning
      sparkThreadDelta (SparkThreadRunning Int
    _) (StopThread ThreadId
    _ ThreadStopStatus
    ThreadFinished) = SparkThreadState -> Maybe SparkThreadState
    forall a. a -> Maybe a
    Just SparkThreadState
    SparkThreadFinal
      sparkThreadDelta (SparkThreadRunning Int
    n) (StopThread ThreadId
    _ ThreadStopStatus
    _)              = SparkThreadState -> Maybe SparkThreadState
    forall a. a -> Maybe a
    Just (Int -> SparkThreadState
    SparkThreadPaused Int
    n)
      sparkThreadDelta (SparkThreadRunning Int
    n) EventInfo
    SparkRun                      = SparkThreadState -> Maybe SparkThreadState
    forall a. a -> Maybe a
    Just (Int -> SparkThreadState
    SparkThreadRunning (Int
    nInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    1))
      sparkThreadDelta (SparkThreadRunning Int
    n) (SparkSteal Int
    _)                = SparkThreadState -> Maybe SparkThreadState
    forall a. a -> Maybe a
    Just (Int -> SparkThreadState
    SparkThreadRunning (Int
    nInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    1))
      -- SparkThreadPaused
      sparkThreadDelta (SparkThreadPaused Int
    n) (RunThread ThreadId
    _) = SparkThreadState -> Maybe SparkThreadState
    forall a. a -> Maybe a
    Just (Int -> SparkThreadState
    SparkThreadRunning Int
    n)
      -- Other
      sparkThreadDelta SparkThreadState
    _ EventInfo
    _ = Maybe SparkThreadState
    forall a. Maybe a
    Nothing

    capabilitySparkThreadMachine :: Machine (Map Int ThreadId, Set ThreadId) Event
    capabilitySparkThreadMachine :: Machine (Map Int ThreadId, Set ThreadId) Event
    capabilitySparkThreadMachine = Machine
      { initial :: (Map Int ThreadId, Set ThreadId)
    initial = (Map Int ThreadId
    forall k a. Map k a
    M.empty, Set ThreadId
    forall a. Set a
    S.empty)
      , final :: (Map Int ThreadId, Set ThreadId) -> Bool
    final   = Bool -> (Map Int ThreadId, Set ThreadId) -> Bool
    forall a b. a -> b -> a
    const Bool
    False
      , alpha :: Event -> Bool
    alpha   = Event -> Bool
    capabilitySparkThreadAlpha
      , delta :: (Map Int ThreadId, Set ThreadId)
    -> Event -> Maybe (Map Int ThreadId, Set ThreadId)
    delta   = (Map Int ThreadId, Set ThreadId)
    -> Event -> Maybe (Map Int ThreadId, Set ThreadId)
    capabilitySparkThreadDelta
      }
     where
      capabilitySparkThreadAlpha :: Event -> Bool
    capabilitySparkThreadAlpha Event
    evt = case Event -> EventInfo
    evSpec Event
    evt of
        (CreateSparkThread ThreadId
    _)         -> Bool
    True
        (RunThread ThreadId
    _)                 -> Bool
    True
        (StopThread ThreadId
    _ ThreadStopStatus
    _)              -> Bool
    True
        EventInfo
    _                             -> Bool
    False
      capabilitySparkThreadDelta :: (Map Int ThreadId, Set ThreadId)
    -> Event -> Maybe (Map Int ThreadId, Set ThreadId)
    capabilitySparkThreadDelta (Map Int ThreadId
    m, Set ThreadId
    s) Event
    evt = do
        capId <- Event -> Maybe Int
    evCap Event
    evt
        case evSpec evt of
          (CreateSparkThread ThreadId
    threadId)         -> ThreadId -> Maybe (Map Int ThreadId, Set ThreadId)
    createThread ThreadId
    threadId
          (StopThread ThreadId
    threadId ThreadStopStatus
    _)              -> ThreadId -> Maybe (Map Int ThreadId, Set ThreadId)
    pauseThread ThreadId
    threadId
          (RunThread ThreadId
    threadId)                 -> Int -> ThreadId -> Maybe (Map Int ThreadId, Set ThreadId)
    runThread Int
    capId ThreadId
    threadId
          EventInfo
    _                                    -> (Map Int ThreadId, Set ThreadId)
    -> Maybe (Map Int ThreadId, Set ThreadId)
    forall a. a -> Maybe a
    Just (Map Int ThreadId
    m, Set ThreadId
    s)
       where
        createThread :: ThreadId -> Maybe (Map Int ThreadId, Set ThreadId)
        createThread :: ThreadId -> Maybe (Map Int ThreadId, Set ThreadId)
    createThread ThreadId
    threadId
          | ThreadId -> Set ThreadId -> Bool
    forall a. Ord a => a -> Set a -> Bool
    S.member ThreadId
    threadId Set ThreadId
    s = Maybe (Map Int ThreadId, Set ThreadId)
    forall a. Maybe a
    Nothing -- A spark thread with this Id already created
          | Bool
    otherwise           = (Map Int ThreadId, Set ThreadId)
    -> Maybe (Map Int ThreadId, Set ThreadId)
    forall a. a -> Maybe a
    Just (Map Int ThreadId
    m, ThreadId -> Set ThreadId -> Set ThreadId
    forall a. Ord a => a -> Set a -> Set a
    S.insert ThreadId
    threadId Set ThreadId
    s)

        runThread :: Int -> ThreadId -> Maybe (Map Int ThreadId, Set ThreadId)
        runThread :: Int -> ThreadId -> Maybe (Map Int ThreadId, Set ThreadId)
    runThread Int
    capId ThreadId
    threadId
          | Int -> Map Int ThreadId -> Bool
    forall k a. Ord k => k -> Map k a -> Bool
    M.member Int
    capId Map Int ThreadId
    m          = Maybe (Map Int ThreadId, Set ThreadId)
    forall a. Maybe a
    Nothing      -- A thread is already on this cap
          | ThreadId
    threadId ThreadId -> [ThreadId] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` Map Int ThreadId -> [ThreadId]
    forall k a. Map k a -> [a]
    M.elems Map Int ThreadId
    m = Maybe (Map Int ThreadId, Set ThreadId)
    forall a. Maybe a
    Nothing      -- This thread is already on a cap
          | ThreadId -> Set ThreadId -> Bool
    forall a. Ord a => a -> Set a -> Bool
    S.notMember ThreadId
    threadId Set ThreadId
    s    = (Map Int ThreadId, Set ThreadId)
    -> Maybe (Map Int ThreadId, Set ThreadId)
    forall a. a -> Maybe a
    Just (Map Int ThreadId
    m, Set ThreadId
    s)  -- Not a spark thread
          | Bool
    otherwise                 = (Map Int ThreadId, Set ThreadId)
    -> Maybe (Map Int ThreadId, Set ThreadId)
    forall a. a -> Maybe a
    Just (Int -> ThreadId -> Map Int ThreadId -> Map Int ThreadId
    forall k a. Ord k => k -> a -> Map k a -> Map k a
    M.insert Int
    capId ThreadId
    threadId Map Int ThreadId
    m, ThreadId -> Set ThreadId -> Set ThreadId
    forall a. Ord a => a -> Set a -> Set a
    S.insert ThreadId
    threadId Set ThreadId
    s)

        stopThread :: ThreadId -> Maybe (Map Int ThreadId, Set ThreadId)
        stopThread :: ThreadId -> Maybe (Map Int ThreadId, Set ThreadId)
    stopThread ThreadId
    threadId = (Map Int ThreadId, Set ThreadId)
    -> Maybe (Map Int ThreadId, Set ThreadId)
    forall a. a -> Maybe a
    Just ((ThreadId -> Bool) -> Map Int ThreadId -> Map Int ThreadId
    forall a k. (a -> Bool) -> Map k a -> Map k a
    M.filter (ThreadId -> ThreadId -> Bool
    forall a. Eq a => a -> a -> Bool
    /= ThreadId
    threadId) Map Int ThreadId
    m, ThreadId -> Set ThreadId -> Set ThreadId
    forall a. Ord a => a -> Set a -> Set a
    S.delete ThreadId
    threadId Set ThreadId
    s)

        pauseThread :: ThreadId -> Maybe (Map Int ThreadId, Set ThreadId)
        pauseThread :: ThreadId -> Maybe (Map Int ThreadId, Set ThreadId)
    pauseThread ThreadId
    threadId = (Map Int ThreadId, Set ThreadId)
    -> Maybe (Map Int ThreadId, Set ThreadId)
    forall a. a -> Maybe a
    Just ((ThreadId -> Bool) -> Map Int ThreadId -> Map Int ThreadId
    forall a k. (a -> Bool) -> Map k a -> Map k a
    M.filter (ThreadId -> ThreadId -> Bool
    forall a. Eq a => a -> a -> Bool
    /= ThreadId
    threadId) Map Int ThreadId
    m, Set ThreadId
    s)

    capabilitySparkThreadIndexer :: (Map Int ThreadId, Set ThreadId) -> Event -> Maybe ThreadId
    capabilitySparkThreadIndexer :: (Map Int ThreadId, Set ThreadId) -> Event -> Maybe ThreadId
    capabilitySparkThreadIndexer (Map Int ThreadId
    m, Set ThreadId
    s) Event
    evt = case Event -> EventInfo
    evSpec Event
    evt of
      (CreateThread ThreadId
    threadId)   -> ThreadId -> Maybe ThreadId
    inSparkThreadPool ThreadId
    threadId
      (RunThread ThreadId
    threadId)      -> ThreadId -> Maybe ThreadId
    inSparkThreadPool ThreadId
    threadId
      (StopThread ThreadId
    threadId ThreadStopStatus
    _)   -> ThreadId -> Maybe ThreadId
    inSparkThreadPool ThreadId
    threadId
      EventInfo
    _                         -> Event -> Maybe Int
    evCap Event
    evt Maybe Int -> (Int -> Maybe ThreadId) -> Maybe ThreadId
    forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= (\Int
    capId -> Int -> Map Int ThreadId -> Maybe ThreadId
    forall k a. Ord k => k -> Map k a -> Maybe a
    M.lookup Int
    capId Map Int ThreadId
    m)
     where
      inSparkThreadPool :: ThreadId -> Maybe ThreadId
      inSparkThreadPool :: ThreadId -> Maybe ThreadId
    inSparkThreadPool ThreadId
    threadId
        | ThreadId -> Set ThreadId -> Bool
    forall a. Ord a => a -> Set a -> Bool
    S.member ThreadId
    threadId Set ThreadId
    s = ThreadId -> Maybe ThreadId
    forall a. a -> Maybe a
    Just ThreadId
    threadId
        | Bool
    otherwise           = Maybe ThreadId
    forall a. Maybe a
    Nothing