{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{- | Support functions to call common live coding functionalities like launching and reloading
from a @ghci@ or @cabal repl@ session.

You typically don't need to import this module in your code,
but you should load it in your interactive session,
ideally by copying the file `essence-of-live-coding/.ghci` to your project,
adjusting it to your needs and launching @cabal repl@.
-}
module LiveCoding.GHCi where

-- base
import Control.Concurrent
import Control.Exception (SomeException, try)
import Control.Monad (void, (>=>))
import Data.Data
import Data.Function ((&))

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

-- foreign-store
import Foreign.Store

-- essence-of-live-coding
import LiveCoding.LiveProgram
import LiveCoding.RuntimeIO.Launch

proxyFromLiveProgram :: LiveProgram m -> Proxy m
proxyFromLiveProgram :: LiveProgram m -> Proxy m
proxyFromLiveProgram LiveProgram m
_ = Proxy m
forall k (t :: k). Proxy t
Proxy

-- * Retrieving launched programs from the foreign store

-- | Try to retrieve a 'LiveProgram' of a given type from the 'Store',
--   handling all 'IO' exceptions.
--   Returns 'Right Nothing' if the store didn't exist.
possiblyLaunchedProgram
  :: Launchable m
  => Proxy m
  -> IO (Either SomeException (Maybe (LaunchedProgram m)))
possiblyLaunchedProgram :: Proxy m -> IO (Either SomeException (Maybe (LaunchedProgram m)))
possiblyLaunchedProgram Proxy m
_ = do
  Maybe (Store (LaunchedProgram m))
storeMaybe <- Word32 -> IO (Maybe (Store (LaunchedProgram m)))
forall a. Word32 -> IO (Maybe (Store a))
lookupStore Word32
0
  IO (Maybe (LaunchedProgram m))
-> IO (Either SomeException (Maybe (LaunchedProgram m)))
forall e a. Exception e => IO a -> IO (Either e a)
try (IO (Maybe (LaunchedProgram m))
 -> IO (Either SomeException (Maybe (LaunchedProgram m))))
-> IO (Maybe (LaunchedProgram m))
-> IO (Either SomeException (Maybe (LaunchedProgram m)))
forall a b. (a -> b) -> a -> b
$ (Store (LaunchedProgram m) -> IO (LaunchedProgram m))
-> Maybe (Store (LaunchedProgram m))
-> IO (Maybe (LaunchedProgram m))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Store (LaunchedProgram m) -> IO (LaunchedProgram m)
forall a. Store a -> IO a
readStore Maybe (Store (LaunchedProgram m))
storeMaybe



-- | Try to load a 'LiveProgram' of a given type from the 'Store'.
--   If the store doesn't contain a program, it is (re)started.
sync :: Launchable m => LiveProgram m -> IO ()
sync :: LiveProgram m -> IO ()
sync LiveProgram m
program = do
  Either SomeException (Maybe (LaunchedProgram m))
launchedProgramPossibly <- Proxy m -> IO (Either SomeException (Maybe (LaunchedProgram m)))
forall (m :: * -> *).
Launchable m =>
Proxy m -> IO (Either SomeException (Maybe (LaunchedProgram m)))
possiblyLaunchedProgram (Proxy m -> IO (Either SomeException (Maybe (LaunchedProgram m))))
-> Proxy m -> IO (Either SomeException (Maybe (LaunchedProgram m)))
forall a b. (a -> b) -> a -> b
$ LiveProgram m -> Proxy m
forall (m :: * -> *). LiveProgram m -> Proxy m
proxyFromLiveProgram LiveProgram m
program
  case Either SomeException (Maybe (LaunchedProgram m))
launchedProgramPossibly of
    -- Looking up the store failed in some way, restart
    Left (SomeException
e :: SomeException) -> String -> IO ()
putStrLn String
"exc" IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> LiveProgram m -> IO ()
forall (m :: * -> *). Launchable m => LiveProgram m -> IO ()
launchAndSave LiveProgram m
program
    -- The store was empty, restart
    Right Maybe (LaunchedProgram m)
Nothing -> String -> IO ()
putStrLn String
"empty" IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> LiveProgram m -> IO ()
forall (m :: * -> *). Launchable m => LiveProgram m -> IO ()
launchAndSave LiveProgram m
program
    -- A program is running, update it
    Right (Just LaunchedProgram m
launchedProgram) -> String -> IO ()
putStrLn String
"update" IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> LaunchedProgram m -> LiveProgram m -> IO ()
forall (m :: * -> *).
Launchable m =>
LaunchedProgram m -> LiveProgram m -> IO ()
update LaunchedProgram m
launchedProgram LiveProgram m
program

-- | Launch a 'LiveProgram' and save it in the 'Store'.
launchAndSave :: Launchable m => LiveProgram m -> IO ()
launchAndSave :: LiveProgram m -> IO ()
launchAndSave = LiveProgram m -> IO (LaunchedProgram m)
forall (m :: * -> *).
Launchable m =>
LiveProgram m -> IO (LaunchedProgram m)
launch (LiveProgram m -> IO (LaunchedProgram m))
-> (LaunchedProgram m -> IO ()) -> LiveProgram m -> IO ()
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> LaunchedProgram m -> IO ()
forall (m :: * -> *). Launchable m => LaunchedProgram m -> IO ()
save

-- | Save a 'LiveProgram' to the store.
save :: Launchable m => LaunchedProgram m -> IO ()
save :: LaunchedProgram m -> IO ()
save = Store (LaunchedProgram m) -> LaunchedProgram m -> IO ()
forall a. Store a -> a -> IO ()
writeStore (Store (LaunchedProgram m) -> LaunchedProgram m -> IO ())
-> Store (LaunchedProgram m) -> LaunchedProgram m -> IO ()
forall a b. (a -> b) -> a -> b
$ Word32 -> Store (LaunchedProgram m)
forall a. Word32 -> Store a
Store Word32
0

-- | Try to retrieve a 'LaunchedProgram' from the 'Store',
--   and if successful, stop it.
stopStored
  :: Launchable m
  => Proxy m
  -> IO ()
stopStored :: Proxy m -> IO ()
stopStored Proxy m
proxy = IO (Either SomeException (Maybe (IO ()))) -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO (Either SomeException (Maybe (IO ()))) -> IO ())
-> IO (Either SomeException (Maybe (IO ()))) -> IO ()
forall a b. (a -> b) -> a -> b
$ ((Either SomeException (Maybe (LaunchedProgram m))
 -> Either SomeException (Maybe (IO ())))
-> IO (Either SomeException (Maybe (LaunchedProgram m)))
-> IO (Either SomeException (Maybe (IO ())))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Either SomeException (Maybe (LaunchedProgram m))
  -> Either SomeException (Maybe (IO ())))
 -> IO (Either SomeException (Maybe (LaunchedProgram m)))
 -> IO (Either SomeException (Maybe (IO ()))))
-> (Either SomeException (Maybe (LaunchedProgram m))
    -> Either SomeException (Maybe (IO ())))
-> IO (Either SomeException (Maybe (LaunchedProgram m)))
-> IO (Either SomeException (Maybe (IO ())))
forall a b. (a -> b) -> a -> b
$ (Maybe (LaunchedProgram m) -> Maybe (IO ()))
-> Either SomeException (Maybe (LaunchedProgram m))
-> Either SomeException (Maybe (IO ()))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Maybe (LaunchedProgram m) -> Maybe (IO ()))
 -> Either SomeException (Maybe (LaunchedProgram m))
 -> Either SomeException (Maybe (IO ())))
-> (Maybe (LaunchedProgram m) -> Maybe (IO ()))
-> Either SomeException (Maybe (LaunchedProgram m))
-> Either SomeException (Maybe (IO ()))
forall a b. (a -> b) -> a -> b
$ (LaunchedProgram m -> IO ())
-> Maybe (LaunchedProgram m) -> Maybe (IO ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap LaunchedProgram m -> IO ()
forall (m :: * -> *). Launchable m => LaunchedProgram m -> IO ()
stop) (IO (Either SomeException (Maybe (LaunchedProgram m)))
 -> IO (Either SomeException (Maybe (IO ()))))
-> IO (Either SomeException (Maybe (LaunchedProgram m)))
-> IO (Either SomeException (Maybe (IO ())))
forall a b. (a -> b) -> a -> b
$ Proxy m -> IO (Either SomeException (Maybe (LaunchedProgram m)))
forall (m :: * -> *).
Launchable m =>
Proxy m -> IO (Either SomeException (Maybe (LaunchedProgram m)))
possiblyLaunchedProgram Proxy m
proxy

-- * GHCi commands

-- ** Debugging
-- TODO Could also parametrise this and all other commands by the 'liveProgram'

-- | Initialise a launched program in the store,
--   but don't start it.
liveinit :: p -> m String
liveinit p
_ = String -> m String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> m String) -> String -> m String
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines
  [ String
"programVar <- newMVar liveProgram"
  , String
"threadId <- myThreadId"
  , String
"save LaunchedProgram { .. }"
  ]

-- | Run one program step, assuming you have a launched program in a variable @launchedProgram@.
livestep :: p -> m String
livestep p
_ = String -> m String
forall (m :: * -> *) a. Monad m => a -> m a
return String
"stepLaunchedProgram launchedProgram"

-- ** Running

-- | Launch or restart a program and save its reference in the store.
livelaunch :: p -> m String
livelaunch p
_ = String -> m String
forall (m :: * -> *) a. Monad m => a -> m a
return String
"sync liveProgram"

-- | Reload the code and do hot code swap and migration.
livereload :: p -> m String
livereload p
_ = String -> m String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> m String) -> String -> m String
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines
  [ String
":reload"
  , String
"sync liveProgram"
  ]

-- | Stop the program.
livestop :: p -> m String
livestop p
_ = String -> m String
forall (m :: * -> *) a. Monad m => a -> m a
return String
"stopStored $ proxyFromLiveProgram liveProgram"