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 :: forall a. a -> Handle IO (IORef a)
ioRefHandle a
a =
  Handle
    { create :: IO (IORef a)
create = forall a. a -> IO (IORef a)
newIORef a
a
    , destroy :: IORef a -> IO ()
destroy = forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ 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 :: forall a. Handle IO (MVar a)
emptyMVarHandle =
  Handle
    { create :: IO (MVar a)
create = forall a. IO (MVar a)
newEmptyMVar
    , destroy :: MVar a -> IO ()
destroy = forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ 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 :: forall a. a -> Handle IO (MVar a)
newMVarHandle a
a =
  Handle
    { create :: IO (MVar a)
create = forall a. a -> IO (MVar a)
newMVar a
a
    , destroy :: MVar a -> IO ()
destroy = forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ 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
    { create :: IO ThreadId
create = IO () -> IO ThreadId
forkIO IO ()
action
    , destroy :: ThreadId -> IO ()
destroy = ThreadId -> IO ()
killThread
    }