module LiveCoding.Handle.Examples where

-- base
import Control.Concurrent
import Data.Data
import Data.IORef

-- essence-of-live-coding
import LiveCoding.Handle

-- | Create an 'IORef', with no special cleanup action.
ioRefHandle :: a -> Handle IO (IORef a)
ioRefHandle :: a -> Handle IO (IORef a)
ioRefHandle a
a = Handle :: forall (m :: * -> *) h. m h -> (h -> m ()) -> Handle m h
Handle
  { create :: IO (IORef a)
create = a -> IO (IORef a)
forall a. a -> IO (IORef a)
newIORef a
a
  , destroy :: IORef a -> IO ()
destroy = IO () -> IORef a -> IO ()
forall a b. a -> b -> a
const (IO () -> IORef a -> IO ()) -> IO () -> IORef a -> IO ()
forall a b. (a -> b) -> a -> b
$ () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return () -- IORefs are garbage collected
  }

-- | Create an uninitialised 'MVar', with no special cleanup action.
emptyMVarHandle :: Handle IO (MVar a)
emptyMVarHandle :: Handle IO (MVar a)
emptyMVarHandle = Handle :: forall (m :: * -> *) h. m h -> (h -> m ()) -> Handle m h
Handle
  { create :: IO (MVar a)
create = IO (MVar a)
forall a. IO (MVar a)
newEmptyMVar
  , destroy :: MVar a -> IO ()
destroy = IO () -> MVar a -> IO ()
forall a b. a -> b -> a
const (IO () -> MVar a -> IO ()) -> IO () -> MVar a -> IO ()
forall a b. (a -> b) -> a -> b
$ () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return () -- MVars are garbage collected
  }

-- | Create an 'MVar' initialised to some value @a@,
--   with no special cleanup action.
newMVarHandle :: a -> Handle IO (MVar a)
newMVarHandle :: a -> Handle IO (MVar a)
newMVarHandle a
a = Handle :: forall (m :: * -> *) h. m h -> (h -> m ()) -> Handle m h
Handle
  { create :: IO (MVar a)
create = a -> IO (MVar a)
forall a. a -> IO (MVar a)
newMVar a
a
  , destroy :: MVar a -> IO ()
destroy = IO () -> MVar a -> IO ()
forall a b. a -> b -> a
const (IO () -> MVar a -> IO ()) -> IO () -> MVar a -> IO ()
forall a b. (a -> b) -> a -> b
$ () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return () -- MVars are garbage collected
  }

-- | Launch a thread executing the given action
--   and kill it when the handle is removed.
threadHandle :: IO () -> Handle IO ThreadId
threadHandle :: IO () -> Handle IO ThreadId
threadHandle IO ()
action = Handle :: forall (m :: * -> *) h. m h -> (h -> m ()) -> Handle m h
Handle
  { create :: IO ThreadId
create  = IO () -> IO ThreadId
forkIO IO ()
action
  , destroy :: ThreadId -> IO ()
destroy = ThreadId -> IO ()
killThread
  }