{-# LANGUAGE GADTs              #-}
{-# LANGUAGE StandaloneDeriving #-}

-- | Internal types shared between `IOSim` and `IOSimPOR`.
--
module Control.Monad.IOSim.InternalTypes
  ( ThreadControl (..)
  , ControlStack (..)
  ) where

import           Control.Exception (Exception)
import           Control.Monad.Class.MonadThrow (MaskingState (..))

import           Control.Monad.IOSim.Types (SimA)

-- We hide the type @b@ here, so it's useful to bundle these two parts together,
-- rather than having Thread have an existential type, which makes record
-- updates awkward.
data ThreadControl s a where
  ThreadControl :: SimA s b
                -> !(ControlStack s b a)
                -> ThreadControl s a

instance Show (ThreadControl s a) where
  show :: ThreadControl s a -> String
show ThreadControl s a
_ = String
"..."

data ControlStack s b a where
  MainFrame  ::  ControlStack s a  a
  ForkFrame  ::  ControlStack s () a
  MaskFrame  ::  (b -> SimA s c)         -- subsequent continuation
             -> !MaskingState            -- thread local state to restore
             -> !(ControlStack s c a)
             ->  ControlStack s b a
  CatchFrame ::  Exception e
             =>  (e -> SimA s b)         -- exception continuation
             ->  (b -> SimA s c)         -- subsequent continuation
             -> !(ControlStack s c a)
             ->  ControlStack s b a

instance Show (ControlStack s b a) where
  show :: ControlStack s b a -> String
show = ControlStackDash -> String
forall a. Show a => a -> String
show (ControlStackDash -> String)
-> (ControlStack s b a -> ControlStackDash)
-> ControlStack s b a
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ControlStack s b a -> ControlStackDash
forall s' b' a'. ControlStack s' b' a' -> ControlStackDash
dash
    where dash :: ControlStack s' b' a' -> ControlStackDash
          dash :: ControlStack s' b' a' -> ControlStackDash
dash ControlStack s' b' a'
MainFrame          = ControlStackDash
MainFrame'
          dash ControlStack s' b' a'
ForkFrame          = ControlStackDash
ForkFrame'
          dash (MaskFrame b' -> SimA s' c
_ MaskingState
m ControlStack s' c a'
s)  = MaskingState -> ControlStackDash -> ControlStackDash
MaskFrame' MaskingState
m (ControlStack s' c a' -> ControlStackDash
forall s' b' a'. ControlStack s' b' a' -> ControlStackDash
dash ControlStack s' c a'
s)
          dash (CatchFrame e -> SimA s' b'
_ b' -> SimA s' c
_ ControlStack s' c a'
s) = ControlStackDash -> ControlStackDash
CatchFrame' (ControlStack s' c a' -> ControlStackDash
forall s' b' a'. ControlStack s' b' a' -> ControlStackDash
dash ControlStack s' c a'
s)

data ControlStackDash =
    MainFrame'
  | ForkFrame'
  | MaskFrame' MaskingState ControlStackDash
  | CatchFrame' ControlStackDash
  deriving Int -> ControlStackDash -> ShowS
[ControlStackDash] -> ShowS
ControlStackDash -> String
(Int -> ControlStackDash -> ShowS)
-> (ControlStackDash -> String)
-> ([ControlStackDash] -> ShowS)
-> Show ControlStackDash
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ControlStackDash] -> ShowS
$cshowList :: [ControlStackDash] -> ShowS
show :: ControlStackDash -> String
$cshow :: ControlStackDash -> String
showsPrec :: Int -> ControlStackDash -> ShowS
$cshowsPrec :: Int -> ControlStackDash -> ShowS
Show