{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE RecordWildCards #-}
module LiveCoding.RuntimeIO.Launch where

-- base
import Control.Concurrent
import Control.Monad
import Data.Data

-- transformers
import Control.Monad.Trans.State.Strict
import Control.Monad.Trans.Except

-- essence-of-live-coding
import LiveCoding.Debugger
import LiveCoding.Handle
import LiveCoding.LiveProgram
import LiveCoding.LiveProgram.Except
import LiveCoding.LiveProgram.HotCodeSwap
import LiveCoding.Cell.Monad.Trans
import LiveCoding.Exceptions.Finite (Finite)
import LiveCoding.HandlingState

{- | Monads in which live programs can be launched in 'IO',
for example when you have special effects that have to be handled on every reload.

The only thing necessary is to transform the 'LiveProgram'
into one in the 'IO' monad, and the rest is taken care of in the framework.
-}
class Monad m => Launchable m where
  runIO :: LiveProgram m -> LiveProgram IO

instance Launchable IO where
  runIO :: LiveProgram IO -> LiveProgram IO
runIO = LiveProgram IO -> LiveProgram IO
forall a. a -> a
id

instance (Typeable m, Launchable m) => Launchable (HandlingStateT m) where
  runIO :: LiveProgram (HandlingStateT m) -> LiveProgram IO
runIO = LiveProgram m -> LiveProgram IO
forall (m :: * -> *).
Launchable m =>
LiveProgram m -> LiveProgram IO
runIO (LiveProgram m -> LiveProgram IO)
-> (LiveProgram (HandlingStateT m) -> LiveProgram m)
-> LiveProgram (HandlingStateT m)
-> LiveProgram IO
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LiveProgram (HandlingStateT m) -> LiveProgram m
forall (m :: * -> *).
(Monad m, Typeable m) =>
LiveProgram (HandlingStateT m) -> LiveProgram m
runHandlingState

-- | Upon an exception, the program is restarted.
--   To handle or log the exception, see "LiveCoding.LiveProgram.Except".
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 = LiveProgram m -> LiveProgram IO
forall (m :: * -> *).
Launchable m =>
LiveProgram m -> LiveProgram IO
runIO (LiveProgram m -> LiveProgram IO)
-> LiveProgram m -> LiveProgram IO
forall a b. (a -> b) -> a -> b
$ LiveProgramExcept m e -> LiveProgram m
forall e (m :: * -> *).
(Data e, Monad m) =>
LiveProgramExcept m e -> LiveProgram m
foreverCLiveProgram (LiveProgramExcept m e -> LiveProgram m)
-> LiveProgramExcept m e -> LiveProgram m
forall a b. (a -> b) -> a -> b
$ LiveProgram (ExceptT e m) -> LiveProgramExcept m e
forall e (m :: * -> *).
(Data e, Finite e, Functor m) =>
LiveProgram (ExceptT e m) -> LiveProgramExcept m e
try LiveProgram (ExceptT e m)
liveProgram

{- | The standard top level @main@ for a live program.

Typically, you will define a top level 'LiveProgram' in some monad like @'HandlingStateT' 'IO'@,
and then add these two lines of boiler plate:

@
main :: IO ()
main = liveMain liveProgram
@
-}
liveMain
  :: Launchable m
  => LiveProgram m
  -> IO ()
liveMain :: LiveProgram m -> IO ()
liveMain = LiveProgram IO -> IO ()
forall (m :: * -> *). Monad m => LiveProgram m -> m ()
foreground (LiveProgram IO -> IO ())
-> (LiveProgram m -> LiveProgram IO) -> LiveProgram m -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LiveProgram m -> LiveProgram IO
forall (m :: * -> *).
Launchable m =>
LiveProgram m -> LiveProgram IO
runIO

-- | Launch a 'LiveProgram' in the foreground thread (blocking).
foreground :: Monad m => LiveProgram m -> m ()
foreground :: LiveProgram m -> m ()
foreground LiveProgram m
liveProgram
  =   LiveProgram m -> m (LiveProgram m)
forall (m :: * -> *). Monad m => LiveProgram m -> m (LiveProgram m)
stepProgram LiveProgram m
liveProgram
  m (LiveProgram m) -> (LiveProgram m -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= LiveProgram m -> m ()
forall (m :: * -> *). Monad m => LiveProgram m -> m ()
foreground

-- | A launched 'LiveProgram' and the thread in which it is running.
data LaunchedProgram (m :: * -> *) = LaunchedProgram
  { LaunchedProgram m -> MVar (LiveProgram IO)
programVar :: MVar (LiveProgram IO)
  , LaunchedProgram m -> ThreadId
threadId   :: ThreadId
  }

{- | Launch a 'LiveProgram' in a separate thread.

The 'MVar' can be used to 'update' the program while automatically migrating it.
The 'ThreadId' represents the thread where the program runs in.
You're advised not to kill it directly, but to run 'stop' instead.
-}
launch
  :: Launchable m
  => LiveProgram m
  -> IO (LaunchedProgram m)
launch :: LiveProgram m -> IO (LaunchedProgram m)
launch LiveProgram m
liveProg = do
  MVar (LiveProgram IO)
programVar <- LiveProgram IO -> IO (MVar (LiveProgram IO))
forall a. a -> IO (MVar a)
newMVar (LiveProgram IO -> IO (MVar (LiveProgram IO)))
-> LiveProgram IO -> IO (MVar (LiveProgram IO))
forall a b. (a -> b) -> a -> b
$ LiveProgram m -> LiveProgram IO
forall (m :: * -> *).
Launchable m =>
LiveProgram m -> LiveProgram IO
runIO LiveProgram m
liveProg
  ThreadId
threadId <- IO () -> IO ThreadId
forkIO (IO () -> IO ThreadId) -> IO () -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ MVar (LiveProgram IO) -> IO ()
background MVar (LiveProgram IO)
programVar
  LaunchedProgram m -> IO (LaunchedProgram m)
forall (m :: * -> *) a. Monad m => a -> m a
return LaunchedProgram :: forall (m :: * -> *).
MVar (LiveProgram IO) -> ThreadId -> LaunchedProgram m
LaunchedProgram { ThreadId
MVar (LiveProgram IO)
threadId :: ThreadId
programVar :: MVar (LiveProgram IO)
threadId :: ThreadId
programVar :: MVar (LiveProgram IO)
.. }

-- | Migrate (using 'hotCodeSwap') the 'LiveProgram' to a new version.
update
  :: Launchable m
  => LaunchedProgram m
  -> LiveProgram     m
  -> IO ()
update :: 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 = MVar (LiveProgram IO)
-> (LiveProgram IO -> IO (LiveProgram IO)) -> IO ()
forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVarMasked_ MVar (LiveProgram IO)
programVar
  ((LiveProgram IO -> IO (LiveProgram IO)) -> IO ())
-> (LiveProgram IO -> IO (LiveProgram IO)) -> IO ()
forall a b. (a -> b) -> a -> b
$ LiveProgram IO -> IO (LiveProgram IO)
forall (m :: * -> *) a. Monad m => a -> m a
return (LiveProgram IO -> IO (LiveProgram IO))
-> (LiveProgram IO -> LiveProgram IO)
-> LiveProgram IO
-> IO (LiveProgram IO)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LiveProgram IO -> LiveProgram IO -> LiveProgram IO
forall (m :: * -> *).
LiveProgram m -> LiveProgram m -> LiveProgram m
hotCodeSwap (LiveProgram m -> LiveProgram IO
forall (m :: * -> *).
Launchable m =>
LiveProgram m -> LiveProgram IO
runIO LiveProgram m
newProg)

{- | Stops a thread where a 'LiveProgram' is being executed.

Before the thread is killed, an empty program (in the monad @m@) is first inserted and stepped.
This can be used to call cleanup actions encoded in the monad,
such as 'HandlingStateT'.
-}
stop
  :: Launchable m
  => LaunchedProgram m
  -> IO ()
stop :: 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
  LaunchedProgram m -> LiveProgram m -> IO ()
forall (m :: * -> *).
Launchable m =>
LaunchedProgram m -> LiveProgram m -> IO ()
update LaunchedProgram m
launchedProgram LiveProgram m
forall a. Monoid a => a
mempty
  LaunchedProgram m -> IO ()
forall (m :: * -> *).
(Monad m, Launchable m) =>
LaunchedProgram m -> IO ()
stepLaunchedProgram LaunchedProgram m
launchedProgram
  ThreadId -> IO ()
killThread ThreadId
threadId

-- | Launch a 'LiveProgram', but first attach a debugger to it.
launchWithDebugger
  :: (Monad m, Launchable m)
  => LiveProgram m
  -> Debugger m
  -> IO (LaunchedProgram m)
launchWithDebugger :: LiveProgram m -> Debugger m -> IO (LaunchedProgram m)
launchWithDebugger LiveProgram m
liveProg Debugger m
debugger = LiveProgram m -> IO (LaunchedProgram m)
forall (m :: * -> *).
Launchable m =>
LiveProgram m -> IO (LaunchedProgram m)
launch (LiveProgram m -> IO (LaunchedProgram m))
-> LiveProgram m -> IO (LaunchedProgram m)
forall a b. (a -> b) -> a -> b
$ LiveProgram m
liveProg LiveProgram m -> Debugger m -> LiveProgram m
forall (m :: * -> *).
Monad m =>
LiveProgram m -> Debugger m -> LiveProgram m
`withDebugger` Debugger m
debugger

-- | This is the background task executed by 'launch'.
background :: MVar (LiveProgram IO) -> IO ()
background :: MVar (LiveProgram IO) -> IO ()
background MVar (LiveProgram IO)
var = IO () -> IO ()
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
  LiveProgram IO
liveProg  <- MVar (LiveProgram IO) -> IO (LiveProgram IO)
forall a. MVar a -> IO a
takeMVar MVar (LiveProgram IO)
var
  LiveProgram IO
liveProg' <- LiveProgram IO -> IO (LiveProgram IO)
forall (m :: * -> *). Monad m => LiveProgram m -> m (LiveProgram m)
stepProgram LiveProgram IO
liveProg
  MVar (LiveProgram IO) -> LiveProgram IO -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar (LiveProgram IO)
var LiveProgram IO
liveProg'

-- | Advance a 'LiveProgram' by a single step.
stepProgram :: Monad m => LiveProgram m -> m (LiveProgram m)
stepProgram :: 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
  LiveProgram m -> m (LiveProgram m)
forall (m :: * -> *) a. Monad m => a -> m a
return LiveProgram :: forall (m :: * -> *) s. Data s => s -> (s -> m s) -> LiveProgram m
LiveProgram { liveState :: s
liveState = s
liveState', s -> m s
liveStep :: s -> m s
liveStep :: s -> m s
.. }

-- | Advance a launched 'LiveProgram' by a single step and store the result.
stepLaunchedProgram
  :: (Monad m, Launchable m)
  => LaunchedProgram m
  -> IO ()
stepLaunchedProgram :: 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)
.. } = MVar (LiveProgram IO)
-> (LiveProgram IO -> IO (LiveProgram IO)) -> IO ()
forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVarMasked_ MVar (LiveProgram IO)
programVar LiveProgram IO -> IO (LiveProgram IO)
forall (m :: * -> *). Monad m => LiveProgram m -> m (LiveProgram m)
stepProgram