{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TypeApplications #-}

module LiveCoding.RuntimeIO.Launch where

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

-- transformers

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

-- essence-of-live-coding

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

{- | 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 = 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

{- | 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 = 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

{- | 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 :: 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

-- | Launch a 'LiveProgram' in the foreground thread (blocking).
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

-- | A launched 'LiveProgram' and the thread in which it is running.
data LaunchedProgram (m :: * -> *) = LaunchedProgram
  { forall (m :: * -> *). LaunchedProgram m -> MVar (LiveProgram IO)
programVar :: MVar (LiveProgram IO)
  , forall (m :: * -> *). 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 :: 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)
..}

-- | Migrate (using 'hotCodeSwap') the 'LiveProgram' to a new version.
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)

{- | 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 :: 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

-- | Launch a 'LiveProgram', but first attach a debugger to it.
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

-- | This is the background task executed by 'launch'.
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'

-- | Advance a 'LiveProgram' by a single step.
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
..}

-- | Advance a launched 'LiveProgram' by a single step and store the result.
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