{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE RecordWildCards #-}

module LiveCoding.HandlingState where

-- base
import Control.Arrow (returnA, arr, (>>>))
import Data.Data

-- transformers
import Control.Monad.Trans.Class (MonadTrans(lift))
import Control.Monad.Trans.State.Strict
import Data.Foldable (traverse_)

-- containers
import Data.IntMap
import qualified Data.IntMap as IntMap

-- essence-of-live-coding
import LiveCoding.Cell
import LiveCoding.Cell.Monad
import LiveCoding.Cell.Monad.Trans
import LiveCoding.LiveProgram
import LiveCoding.LiveProgram.Monad.Trans

data Handling h where
  Handling
    :: { Handling h -> Key
key    :: Key
       , Handling h -> h
handle :: h
       }
    -> Handling h
  Uninitialized :: Handling h

type Destructors m = IntMap (Destructor m)

-- | Hold a map of registered handle keys and destructors
data HandlingState m = HandlingState
  { HandlingState m -> Key
nHandles    :: Key
  , HandlingState m -> Destructors m
destructors :: Destructors m
  }
  deriving Typeable (HandlingState m)
DataType
Constr
Typeable (HandlingState m)
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> HandlingState m -> c (HandlingState m))
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c (HandlingState m))
-> (HandlingState m -> Constr)
-> (HandlingState m -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c (HandlingState m)))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c (HandlingState m)))
-> ((forall b. Data b => b -> b)
    -> HandlingState m -> HandlingState m)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> HandlingState m -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> HandlingState m -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> HandlingState m -> [u])
-> (forall u.
    Key -> (forall d. Data d => d -> u) -> HandlingState m -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> HandlingState m -> m (HandlingState m))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> HandlingState m -> m (HandlingState m))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> HandlingState m -> m (HandlingState m))
-> Data (HandlingState m)
HandlingState m -> DataType
HandlingState m -> Constr
(forall b. Data b => b -> b) -> HandlingState m -> HandlingState m
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> HandlingState m -> c (HandlingState m)
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (HandlingState m)
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Key -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Key -> (forall d. Data d => d -> u) -> HandlingState m -> u
forall u. (forall d. Data d => d -> u) -> HandlingState m -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> HandlingState m -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> HandlingState m -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> HandlingState m -> m (HandlingState m)
forall (m :: * -> *). Typeable m => Typeable (HandlingState m)
forall (m :: * -> *). Typeable m => HandlingState m -> DataType
forall (m :: * -> *). Typeable m => HandlingState m -> Constr
forall (m :: * -> *).
Typeable m =>
(forall b. Data b => b -> b) -> HandlingState m -> HandlingState m
forall (m :: * -> *) u.
Typeable m =>
Key -> (forall d. Data d => d -> u) -> HandlingState m -> u
forall (m :: * -> *) u.
Typeable m =>
(forall d. Data d => d -> u) -> HandlingState m -> [u]
forall (m :: * -> *) r r'.
Typeable m =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> HandlingState m -> r
forall (m :: * -> *) r r'.
Typeable m =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> HandlingState m -> r
forall (m :: * -> *) (m :: * -> *).
(Typeable m, Monad m) =>
(forall d. Data d => d -> m d)
-> HandlingState m -> m (HandlingState m)
forall (m :: * -> *) (m :: * -> *).
(Typeable m, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> HandlingState m -> m (HandlingState m)
forall (m :: * -> *) (c :: * -> *).
Typeable m =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (HandlingState m)
forall (m :: * -> *) (c :: * -> *).
Typeable m =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> HandlingState m -> c (HandlingState m)
forall (m :: * -> *) (t :: * -> *) (c :: * -> *).
(Typeable m, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (HandlingState m))
forall (m :: * -> *) (t :: * -> * -> *) (c :: * -> *).
(Typeable m, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (HandlingState m))
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HandlingState m -> m (HandlingState m)
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (HandlingState m)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> HandlingState m -> c (HandlingState m)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (HandlingState m))
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (HandlingState m))
$cHandlingState :: Constr
$tHandlingState :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> HandlingState m -> m (HandlingState m)
$cgmapMo :: forall (m :: * -> *) (m :: * -> *).
(Typeable m, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> HandlingState m -> m (HandlingState m)
gmapMp :: (forall d. Data d => d -> m d)
-> HandlingState m -> m (HandlingState m)
$cgmapMp :: forall (m :: * -> *) (m :: * -> *).
(Typeable m, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> HandlingState m -> m (HandlingState m)
gmapM :: (forall d. Data d => d -> m d)
-> HandlingState m -> m (HandlingState m)
$cgmapM :: forall (m :: * -> *) (m :: * -> *).
(Typeable m, Monad m) =>
(forall d. Data d => d -> m d)
-> HandlingState m -> m (HandlingState m)
gmapQi :: Key -> (forall d. Data d => d -> u) -> HandlingState m -> u
$cgmapQi :: forall (m :: * -> *) u.
Typeable m =>
Key -> (forall d. Data d => d -> u) -> HandlingState m -> u
gmapQ :: (forall d. Data d => d -> u) -> HandlingState m -> [u]
$cgmapQ :: forall (m :: * -> *) u.
Typeable m =>
(forall d. Data d => d -> u) -> HandlingState m -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> HandlingState m -> r
$cgmapQr :: forall (m :: * -> *) r r'.
Typeable m =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> HandlingState m -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> HandlingState m -> r
$cgmapQl :: forall (m :: * -> *) r r'.
Typeable m =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> HandlingState m -> r
gmapT :: (forall b. Data b => b -> b) -> HandlingState m -> HandlingState m
$cgmapT :: forall (m :: * -> *).
Typeable m =>
(forall b. Data b => b -> b) -> HandlingState m -> HandlingState m
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (HandlingState m))
$cdataCast2 :: forall (m :: * -> *) (t :: * -> * -> *) (c :: * -> *).
(Typeable m, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (HandlingState m))
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c (HandlingState m))
$cdataCast1 :: forall (m :: * -> *) (t :: * -> *) (c :: * -> *).
(Typeable m, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (HandlingState m))
dataTypeOf :: HandlingState m -> DataType
$cdataTypeOf :: forall (m :: * -> *). Typeable m => HandlingState m -> DataType
toConstr :: HandlingState m -> Constr
$ctoConstr :: forall (m :: * -> *). Typeable m => HandlingState m -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (HandlingState m)
$cgunfold :: forall (m :: * -> *) (c :: * -> *).
Typeable m =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (HandlingState m)
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> HandlingState m -> c (HandlingState m)
$cgfoldl :: forall (m :: * -> *) (c :: * -> *).
Typeable m =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> HandlingState m -> c (HandlingState m)
$cp1Data :: forall (m :: * -> *). Typeable m => Typeable (HandlingState m)
Data

-- | In this monad, handles can be registered,
--   and their destructors automatically executed.
--   It is basically a monad in which handles are automatically garbage collected.
type HandlingStateT m = StateT (HandlingState m) m

initHandlingState :: HandlingState m
initHandlingState :: HandlingState m
initHandlingState = HandlingState :: forall (m :: * -> *). Key -> Destructors m -> HandlingState m
HandlingState
  { nHandles :: Key
nHandles = Key
0
  , destructors :: Destructors m
destructors = Destructors m
forall a. IntMap a
IntMap.empty
  }

-- | Handle the 'HandlingStateT' effect _without_ garbage collection.
--   Apply this to your main loop after calling 'foreground'.
--   Since there is no garbage collection, don't use this function for live coding.
runHandlingStateT
  :: Monad m
  => HandlingStateT m a
  -> m a
runHandlingStateT :: HandlingStateT m a -> m a
runHandlingStateT = (HandlingStateT m a -> HandlingState m -> m a)
-> HandlingState m -> HandlingStateT m a -> m a
forall a b c. (a -> b -> c) -> b -> a -> c
flip HandlingStateT m a -> HandlingState m -> m a
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT HandlingState m
forall (m :: * -> *). HandlingState m
initHandlingState

{- | Apply this to your main live cell before passing it to the runtime.

On the first tick, it initialises the 'HandlingState' at "no handles".

On every step, it does:

1. Unregister all handles
2. Register currently present handles
3. Destroy all still unregistered handles
   (i.e. those that were removed in the last tick)
-}
runHandlingStateC
  :: forall m a b .
     (Monad m, Typeable m)
  => Cell (HandlingStateT m) a b
  -> Cell                 m  a b
runHandlingStateC :: Cell (HandlingStateT m) a b -> Cell m a b
runHandlingStateC Cell (HandlingStateT m) a b
cell = (Cell (HandlingStateT m) a b -> HandlingState m -> Cell m a b)
-> HandlingState m -> Cell (HandlingStateT m) a b -> Cell m a b
forall a b c. (a -> b -> c) -> b -> a -> c
flip Cell (HandlingStateT m) a b -> HandlingState m -> Cell m a b
forall stateT (m :: * -> *) a b.
(Data stateT, Monad m) =>
Cell (StateT stateT m) a b -> stateT -> Cell m a b
runStateC_ HandlingState m
forall (m :: * -> *). HandlingState m
initHandlingState
  (Cell (HandlingStateT m) a b -> Cell m a b)
-> Cell (HandlingStateT m) a b -> Cell m a b
forall a b. (a -> b) -> a -> b
$ (forall s. HandlingStateT m (b, s) -> HandlingStateT m (b, s))
-> Cell (HandlingStateT m) a b -> Cell (HandlingStateT m) a b
forall (m1 :: * -> *) (m2 :: * -> *) b1 b2 a.
(Monad m1, Monad m2) =>
(forall s. m1 (b1, s) -> m2 (b2, s))
-> Cell m1 a b1 -> Cell m2 a b2
hoistCellOutput forall s. HandlingStateT m (b, s) -> HandlingStateT m (b, s)
forall (m :: * -> *) a.
Monad m =>
HandlingStateT m a -> HandlingStateT m a
garbageCollected Cell (HandlingStateT m) a b
cell

-- | Like 'runHandlingStateC', but for whole live programs.
runHandlingState
  :: (Monad m, Typeable m)
  => LiveProgram (HandlingStateT m)
  -> LiveProgram                 m
runHandlingState :: LiveProgram (HandlingStateT m) -> LiveProgram m
runHandlingState LiveProgram { s
s -> HandlingStateT m s
liveStep :: ()
liveState :: ()
liveStep :: s -> HandlingStateT m s
liveState :: s
.. } = (LiveProgram (HandlingStateT m)
 -> HandlingState m -> LiveProgram m)
-> HandlingState m
-> LiveProgram (HandlingStateT m)
-> LiveProgram m
forall a b c. (a -> b -> c) -> b -> a -> c
flip LiveProgram (HandlingStateT m) -> HandlingState m -> LiveProgram m
forall stateT (m :: * -> *).
(Data stateT, Monad m) =>
LiveProgram (StateT stateT m) -> stateT -> LiveProgram m
runStateL HandlingState m
forall (m :: * -> *). HandlingState m
initHandlingState LiveProgram :: forall (m :: * -> *) s. Data s => s -> (s -> m s) -> LiveProgram m
LiveProgram
  { liveStep :: s -> HandlingStateT m s
liveStep = HandlingStateT m s -> HandlingStateT m s
forall (m :: * -> *) a.
Monad m =>
HandlingStateT m a -> HandlingStateT m a
garbageCollected (HandlingStateT m s -> HandlingStateT m s)
-> (s -> HandlingStateT m s) -> s -> HandlingStateT m s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> HandlingStateT m s
liveStep
  , s
liveState :: s
liveState :: s
..
  }

garbageCollected
  :: Monad m
  => HandlingStateT m a
  -> HandlingStateT m a
garbageCollected :: HandlingStateT m a -> HandlingStateT m a
garbageCollected HandlingStateT m a
action = HandlingStateT m ()
forall (m :: * -> *). Monad m => HandlingStateT m ()
unregisterAll HandlingStateT m () -> HandlingStateT m a -> HandlingStateT m a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> HandlingStateT m a
action HandlingStateT m a -> HandlingStateT m () -> HandlingStateT m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* HandlingStateT m ()
forall (m :: * -> *). Monad m => HandlingStateT m ()
destroyUnregistered

data Destructor m = Destructor
  { Destructor m -> Bool
isRegistered :: Bool
  , Destructor m -> m ()
action       :: m ()
  }


register
  :: Monad m
  => m () -- ^ Destructor
  -> HandlingStateT m Key
register :: m () -> HandlingStateT m Key
register m ()
destructor = do
  HandlingState { Key
Destructors m
destructors :: Destructors m
nHandles :: Key
destructors :: forall (m :: * -> *). HandlingState m -> Destructors m
nHandles :: forall (m :: * -> *). HandlingState m -> Key
.. } <- StateT (HandlingState m) m (HandlingState m)
forall (m :: * -> *) s. Monad m => StateT s m s
get
  let key :: Key
key = Key
nHandles Key -> Key -> Key
forall a. Num a => a -> a -> a
+ Key
1
  HandlingState m -> StateT (HandlingState m) m ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put HandlingState :: forall (m :: * -> *). Key -> Destructors m -> HandlingState m
HandlingState
    { nHandles :: Key
nHandles = Key
key
    , destructors :: Destructors m
destructors = m () -> Key -> Destructors m -> Destructors m
forall (m :: * -> *). m () -> Key -> Destructors m -> Destructors m
insertDestructor m ()
destructor Key
key Destructors m
destructors
    }
  Key -> HandlingStateT m Key
forall (m :: * -> *) a. Monad m => a -> m a
return Key
key

reregister
  :: Monad m
  => m ()
  -> Key
  -> HandlingStateT m ()
reregister :: m () -> Key -> HandlingStateT m ()
reregister m ()
action Key
key = do
  HandlingState { Key
Destructors m
destructors :: Destructors m
nHandles :: Key
destructors :: forall (m :: * -> *). HandlingState m -> Destructors m
nHandles :: forall (m :: * -> *). HandlingState m -> Key
.. } <- StateT (HandlingState m) m (HandlingState m)
forall (m :: * -> *) s. Monad m => StateT s m s
get
  HandlingState m -> HandlingStateT m ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put HandlingState :: forall (m :: * -> *). Key -> Destructors m -> HandlingState m
HandlingState { destructors :: Destructors m
destructors = m () -> Key -> Destructors m -> Destructors m
forall (m :: * -> *). m () -> Key -> Destructors m -> Destructors m
insertDestructor m ()
action Key
key Destructors m
destructors, Key
nHandles :: Key
nHandles :: Key
.. }

insertDestructor
  :: m ()
  -> Key
  -> Destructors m
  -> Destructors m
insertDestructor :: m () -> Key -> Destructors m -> Destructors m
insertDestructor m ()
action Key
key Destructors m
destructors =
  let destructor :: Destructor m
destructor = Destructor :: forall (m :: * -> *). Bool -> m () -> Destructor m
Destructor { isRegistered :: Bool
isRegistered = Bool
True, m ()
action :: m ()
action :: m ()
.. }
  in  Key -> Destructor m -> Destructors m -> Destructors m
forall a. Key -> a -> IntMap a -> IntMap a
insert Key
key Destructor m
destructor Destructors m
destructors

unregisterAll
  :: Monad m
  => HandlingStateT m ()
unregisterAll :: HandlingStateT m ()
unregisterAll = do
  HandlingState { Key
Destructors m
destructors :: Destructors m
nHandles :: Key
destructors :: forall (m :: * -> *). HandlingState m -> Destructors m
nHandles :: forall (m :: * -> *). HandlingState m -> Key
.. } <- StateT (HandlingState m) m (HandlingState m)
forall (m :: * -> *) s. Monad m => StateT s m s
get
  let newDestructors :: Destructors m
newDestructors = (Destructor m -> Destructor m) -> Destructors m -> Destructors m
forall a b. (a -> b) -> IntMap a -> IntMap b
IntMap.map (\Destructor m
destructor -> Destructor m
destructor { isRegistered :: Bool
isRegistered = Bool
False }) Destructors m
destructors
  HandlingState m -> HandlingStateT m ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put HandlingState :: forall (m :: * -> *). Key -> Destructors m -> HandlingState m
HandlingState { destructors :: Destructors m
destructors = Destructors m
newDestructors, Key
nHandles :: Key
nHandles :: Key
.. }

destroyUnregistered
  :: Monad m
  => HandlingStateT m ()
destroyUnregistered :: HandlingStateT m ()
destroyUnregistered = do
  HandlingState { Key
Destructors m
destructors :: Destructors m
nHandles :: Key
destructors :: forall (m :: * -> *). HandlingState m -> Destructors m
nHandles :: forall (m :: * -> *). HandlingState m -> Key
.. } <- StateT (HandlingState m) m (HandlingState m)
forall (m :: * -> *) s. Monad m => StateT s m s
get
  let
      (Destructors m
registered, Destructors m
unregistered) = (Destructor m -> Bool)
-> Destructors m -> (Destructors m, Destructors m)
forall a. (a -> Bool) -> IntMap a -> (IntMap a, IntMap a)
partition Destructor m -> Bool
forall (m :: * -> *). Destructor m -> Bool
isRegistered Destructors m
destructors
  (Destructor m -> HandlingStateT m ())
-> Destructors m -> HandlingStateT m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (m () -> HandlingStateT m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> HandlingStateT m ())
-> (Destructor m -> m ()) -> Destructor m -> HandlingStateT m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Destructor m -> m ()
forall (m :: * -> *). Destructor m -> m ()
action) Destructors m
unregistered
  HandlingState m -> HandlingStateT m ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put HandlingState :: forall (m :: * -> *). Key -> Destructors m -> HandlingState m
HandlingState { destructors :: Destructors m
destructors = Destructors m
registered, Key
nHandles :: Key
nHandles :: Key
.. }

-- * 'Data' instances

dataTypeHandling :: DataType
dataTypeHandling :: DataType
dataTypeHandling = String -> [Constr] -> DataType
mkDataType String
"Handling" [Constr
handlingConstr, Constr
uninitializedConstr]

handlingConstr :: Constr
handlingConstr :: Constr
handlingConstr = DataType -> String -> [String] -> Fixity -> Constr
mkConstr DataType
dataTypeHandling String
"Handling" [] Fixity
Prefix

uninitializedConstr :: Constr
uninitializedConstr :: Constr
uninitializedConstr = DataType -> String -> [String] -> Fixity -> Constr
mkConstr DataType
dataTypeHandling String
"Uninitialized" [] Fixity
Prefix

instance (Typeable h) => Data (Handling h) where
  dataTypeOf :: Handling h -> DataType
dataTypeOf Handling h
_ = DataType
dataTypeHandling
  toConstr :: Handling h -> Constr
toConstr Handling { h
Key
handle :: h
key :: Key
handle :: forall h. Handling h -> h
key :: forall h. Handling h -> Key
.. } = Constr
handlingConstr
  toConstr Handling h
Uninitialized = Constr
uninitializedConstr
  gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Handling h)
gunfold forall b r. Data b => c (b -> r) -> c r
_cons forall r. r -> c r
nil Constr
constructor = Handling h -> c (Handling h)
forall r. r -> c r
nil Handling h
forall h. Handling h
Uninitialized

dataTypeDestructor :: DataType
dataTypeDestructor :: DataType
dataTypeDestructor = String -> [Constr] -> DataType
mkDataType String
"Destructor" [ Constr
destructorConstr ]

destructorConstr :: Constr
destructorConstr :: Constr
destructorConstr = DataType -> String -> [String] -> Fixity -> Constr
mkConstr DataType
dataTypeDestructor String
"Destructor" [] Fixity
Prefix

instance Typeable m => Data (Destructor m) where
  dataTypeOf :: Destructor m -> DataType
dataTypeOf Destructor m
_ = DataType
dataTypeDestructor
  toConstr :: Destructor m -> Constr
toConstr Destructor { m ()
Bool
action :: m ()
isRegistered :: Bool
action :: forall (m :: * -> *). Destructor m -> m ()
isRegistered :: forall (m :: * -> *). Destructor m -> Bool
.. } = Constr
destructorConstr
  gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Destructor m)
gunfold forall b r. Data b => c (b -> r) -> c r
_ forall r. r -> c r
_ = String -> Constr -> c (Destructor m)
forall a. HasCallStack => String -> a
error String
"Destructor.gunfold"