{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TypeApplications #-}
module LiveCoding.RuntimeIO.Launch where
import Control.Concurrent
import Control.Monad
import Data.Data
import Control.Monad.Trans.Except
import Control.Monad.Trans.State.Strict
import LiveCoding.Cell.Monad.Trans
import LiveCoding.Debugger
import LiveCoding.Exceptions.Finite (Finite)
import LiveCoding.Handle
import LiveCoding.HandlingState
import LiveCoding.LiveProgram
import LiveCoding.LiveProgram.Except
import LiveCoding.LiveProgram.HotCodeSwap
class Monad m => Launchable m where
runIO :: LiveProgram m -> LiveProgram IO
instance Launchable IO where
runIO :: LiveProgram IO -> LiveProgram IO
runIO = forall a. a -> a
id
instance (Typeable m, Launchable m) => Launchable (HandlingStateT m) where
runIO :: LiveProgram (HandlingStateT m) -> LiveProgram IO
runIO = forall (m :: * -> *).
Launchable m =>
LiveProgram m -> LiveProgram IO
runIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *).
(Monad m, Typeable m) =>
LiveProgram (HandlingStateT m) -> LiveProgram m
runHandlingState
instance (Data e, Finite e, Launchable m) => Launchable (ExceptT e m) where
runIO :: LiveProgram (ExceptT e m) -> LiveProgram IO
runIO LiveProgram (ExceptT e m)
liveProgram = forall (m :: * -> *).
Launchable m =>
LiveProgram m -> LiveProgram IO
runIO forall a b. (a -> b) -> a -> b
$ forall e (m :: * -> *).
(Data e, Monad m) =>
LiveProgramExcept m e -> LiveProgram m
foreverCLiveProgram forall a b. (a -> b) -> a -> b
$ forall e (m :: * -> *).
(Data e, Finite e, Functor m) =>
LiveProgram (ExceptT e m) -> LiveProgramExcept m e
try LiveProgram (ExceptT e m)
liveProgram
liveMain ::
Launchable m =>
LiveProgram m ->
IO ()
liveMain :: forall (m :: * -> *). Launchable m => LiveProgram m -> IO ()
liveMain = forall (m :: * -> *). Monad m => LiveProgram m -> m ()
foreground forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *).
Launchable m =>
LiveProgram m -> LiveProgram IO
runIO
foreground :: Monad m => LiveProgram m -> m ()
foreground :: forall (m :: * -> *). Monad m => LiveProgram m -> m ()
foreground LiveProgram m
liveProgram =
forall (m :: * -> *). Monad m => LiveProgram m -> m (LiveProgram m)
stepProgram LiveProgram m
liveProgram
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *). Monad m => LiveProgram m -> m ()
foreground
data LaunchedProgram (m :: * -> *) = LaunchedProgram
{ forall (m :: * -> *). LaunchedProgram m -> MVar (LiveProgram IO)
programVar :: MVar (LiveProgram IO)
, forall (m :: * -> *). LaunchedProgram m -> ThreadId
threadId :: ThreadId
}
launch ::
Launchable m =>
LiveProgram m ->
IO (LaunchedProgram m)
launch :: forall (m :: * -> *).
Launchable m =>
LiveProgram m -> IO (LaunchedProgram m)
launch LiveProgram m
liveProg = do
MVar (LiveProgram IO)
programVar <- forall a. a -> IO (MVar a)
newMVar forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
Launchable m =>
LiveProgram m -> LiveProgram IO
runIO LiveProgram m
liveProg
ThreadId
threadId <- IO () -> IO ThreadId
forkIO forall a b. (a -> b) -> a -> b
$ MVar (LiveProgram IO) -> IO ()
background MVar (LiveProgram IO)
programVar
forall (m :: * -> *) a. Monad m => a -> m a
return LaunchedProgram {ThreadId
MVar (LiveProgram IO)
threadId :: ThreadId
programVar :: MVar (LiveProgram IO)
threadId :: ThreadId
programVar :: MVar (LiveProgram IO)
..}
update ::
Launchable m =>
LaunchedProgram m ->
LiveProgram m ->
IO ()
update :: forall (m :: * -> *).
Launchable m =>
LaunchedProgram m -> LiveProgram m -> IO ()
update LaunchedProgram {ThreadId
MVar (LiveProgram IO)
threadId :: ThreadId
programVar :: MVar (LiveProgram IO)
threadId :: forall (m :: * -> *). LaunchedProgram m -> ThreadId
programVar :: forall (m :: * -> *). LaunchedProgram m -> MVar (LiveProgram IO)
..} LiveProgram m
newProg =
forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVarMasked_ MVar (LiveProgram IO)
programVar forall a b. (a -> b) -> a -> b
$
forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *).
LiveProgram m -> LiveProgram m -> LiveProgram m
hotCodeSwap (forall (m :: * -> *).
Launchable m =>
LiveProgram m -> LiveProgram IO
runIO LiveProgram m
newProg)
stop ::
Launchable m =>
LaunchedProgram m ->
IO ()
stop :: forall (m :: * -> *). Launchable m => LaunchedProgram m -> IO ()
stop launchedProgram :: LaunchedProgram m
launchedProgram@LaunchedProgram {ThreadId
MVar (LiveProgram IO)
threadId :: ThreadId
programVar :: MVar (LiveProgram IO)
threadId :: forall (m :: * -> *). LaunchedProgram m -> ThreadId
programVar :: forall (m :: * -> *). LaunchedProgram m -> MVar (LiveProgram IO)
..} = do
forall (m :: * -> *).
Launchable m =>
LaunchedProgram m -> LiveProgram m -> IO ()
update LaunchedProgram m
launchedProgram forall a. Monoid a => a
mempty
forall (m :: * -> *).
(Monad m, Launchable m) =>
LaunchedProgram m -> IO ()
stepLaunchedProgram LaunchedProgram m
launchedProgram
ThreadId -> IO ()
killThread ThreadId
threadId
launchWithDebugger ::
(Monad m, Launchable m) =>
LiveProgram m ->
Debugger m ->
IO (LaunchedProgram m)
launchWithDebugger :: forall (m :: * -> *).
(Monad m, Launchable m) =>
LiveProgram m -> Debugger m -> IO (LaunchedProgram m)
launchWithDebugger LiveProgram m
liveProg Debugger m
debugger = forall (m :: * -> *).
Launchable m =>
LiveProgram m -> IO (LaunchedProgram m)
launch forall a b. (a -> b) -> a -> b
$ LiveProgram m
liveProg forall (m :: * -> *).
Monad m =>
LiveProgram m -> Debugger m -> LiveProgram m
`withDebugger` Debugger m
debugger
background :: MVar (LiveProgram IO) -> IO ()
background :: MVar (LiveProgram IO) -> IO ()
background MVar (LiveProgram IO)
var = forall (f :: * -> *) a b. Applicative f => f a -> f b
forever forall a b. (a -> b) -> a -> b
$ do
LiveProgram IO
liveProg <- forall a. MVar a -> IO a
takeMVar MVar (LiveProgram IO)
var
LiveProgram IO
liveProg' <- forall (m :: * -> *). Monad m => LiveProgram m -> m (LiveProgram m)
stepProgram LiveProgram IO
liveProg
forall a. MVar a -> a -> IO ()
putMVar MVar (LiveProgram IO)
var LiveProgram IO
liveProg'
stepProgram :: Monad m => LiveProgram m -> m (LiveProgram m)
stepProgram :: forall (m :: * -> *). Monad m => LiveProgram m -> m (LiveProgram m)
stepProgram LiveProgram {s
s -> m s
liveStep :: ()
liveState :: ()
liveStep :: s -> m s
liveState :: s
..} = do
s
liveState' <- s -> m s
liveStep s
liveState
forall (m :: * -> *) a. Monad m => a -> m a
return LiveProgram {liveState :: s
liveState = s
liveState', s -> m s
liveStep :: s -> m s
liveStep :: s -> m s
..}
stepLaunchedProgram ::
(Monad m, Launchable m) =>
LaunchedProgram m ->
IO ()
stepLaunchedProgram :: forall (m :: * -> *).
(Monad m, Launchable m) =>
LaunchedProgram m -> IO ()
stepLaunchedProgram LaunchedProgram {ThreadId
MVar (LiveProgram IO)
threadId :: ThreadId
programVar :: MVar (LiveProgram IO)
threadId :: forall (m :: * -> *). LaunchedProgram m -> ThreadId
programVar :: forall (m :: * -> *). LaunchedProgram m -> MVar (LiveProgram IO)
..} = forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVarMasked_ MVar (LiveProgram IO)
programVar forall (m :: * -> *). Monad m => LiveProgram m -> m (LiveProgram m)
stepProgram