{-# 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, Exception (toException, displayException))
import Control.Monad (void, (>=>), join)
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

-- | An exception type marking the absence of a foreign store of the correct type.
data NoStore = NoStore
  deriving Int -> NoStore -> ShowS
[NoStore] -> ShowS
NoStore -> String
(Int -> NoStore -> ShowS)
-> (NoStore -> String) -> ([NoStore] -> ShowS) -> Show NoStore
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NoStore] -> ShowS
$cshowList :: [NoStore] -> ShowS
show :: NoStore -> String
$cshow :: NoStore -> String
showsPrec :: Int -> NoStore -> ShowS
$cshowsPrec :: Int -> NoStore -> ShowS
Show

instance Exception NoStore

-- * 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 (LaunchedProgram m))
possiblyLaunchedProgram :: Proxy m -> IO (Either SomeException (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
  (Either SomeException (Either SomeException (LaunchedProgram m))
 -> Either SomeException (LaunchedProgram m))
-> IO
     (Either SomeException (Either SomeException (LaunchedProgram m)))
-> IO (Either SomeException (LaunchedProgram m))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Either SomeException (Either SomeException (LaunchedProgram m))
-> Either SomeException (LaunchedProgram m)
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (IO
   (Either SomeException (Either SomeException (LaunchedProgram m)))
 -> IO (Either SomeException (LaunchedProgram m)))
-> IO
     (Either SomeException (Either SomeException (LaunchedProgram m)))
-> IO (Either SomeException (LaunchedProgram m))
forall a b. (a -> b) -> a -> b
$ IO (Either SomeException (LaunchedProgram m))
-> IO
     (Either SomeException (Either SomeException (LaunchedProgram m)))
forall e a. Exception e => IO a -> IO (Either e a)
try (IO (Either SomeException (LaunchedProgram m))
 -> IO
      (Either SomeException (Either SomeException (LaunchedProgram m))))
-> IO (Either SomeException (LaunchedProgram m))
-> IO
     (Either SomeException (Either SomeException (LaunchedProgram m)))
forall a b. (a -> b) -> a -> b
$ (Store (LaunchedProgram m) -> IO (LaunchedProgram m))
-> Either SomeException (Store (LaunchedProgram m))
-> IO (Either SomeException (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 (Either SomeException (Store (LaunchedProgram m))
 -> IO (Either SomeException (LaunchedProgram m)))
-> Either SomeException (Store (LaunchedProgram m))
-> IO (Either SomeException (LaunchedProgram m))
forall a b. (a -> b) -> a -> b
$ Either SomeException (Store (LaunchedProgram m))
-> (Store (LaunchedProgram m)
    -> Either SomeException (Store (LaunchedProgram m)))
-> Maybe (Store (LaunchedProgram m))
-> Either SomeException (Store (LaunchedProgram m))
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (SomeException -> Either SomeException (Store (LaunchedProgram m))
forall a b. a -> Either a b
Left (SomeException -> Either SomeException (Store (LaunchedProgram m)))
-> SomeException
-> Either SomeException (Store (LaunchedProgram m))
forall a b. (a -> b) -> a -> b
$ NoStore -> SomeException
forall e. Exception e => e -> SomeException
toException NoStore
NoStore) Store (LaunchedProgram m)
-> Either SomeException (Store (LaunchedProgram m))
forall a b. b -> Either a b
Right 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 (LaunchedProgram m)
launchedProgramPossibly <- Proxy m -> IO (Either SomeException (LaunchedProgram m))
forall (m :: * -> *).
Launchable m =>
Proxy m -> IO (Either SomeException (LaunchedProgram m))
possiblyLaunchedProgram (Proxy m -> IO (Either SomeException (LaunchedProgram m)))
-> Proxy m -> IO (Either SomeException (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 (LaunchedProgram m)
launchedProgramPossibly of
    -- Looking up the store failed in some way, restart
    Left (SomeException
e :: SomeException) -> do
      String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ SomeException -> String
forall e. Exception e => e -> String
displayException SomeException
e
      LiveProgram m -> IO ()
forall (m :: * -> *). Launchable m => LiveProgram m -> IO ()
launchAndSave LiveProgram m
program

    -- A program is running, update it
    Right LaunchedProgram m
launchedProgram -> do
      String -> IO ()
putStrLn String
"update"
      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 = do
  Either SomeException (LaunchedProgram m)
launchedProgramPossibly <- Proxy m -> IO (Either SomeException (LaunchedProgram m))
forall (m :: * -> *).
Launchable m =>
Proxy m -> IO (Either SomeException (LaunchedProgram m))
possiblyLaunchedProgram Proxy m
proxy
  (SomeException -> IO ())
-> (LaunchedProgram m -> IO ())
-> Either SomeException (LaunchedProgram m)
-> IO ()
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> IO ()
putStrLn (String -> IO ())
-> (SomeException -> String) -> SomeException -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SomeException -> String
forall e. Exception e => e -> String
displayException) LaunchedProgram m -> IO ()
forall (m :: * -> *). Launchable m => LaunchedProgram m -> IO ()
stop Either SomeException (LaunchedProgram m)
launchedProgramPossibly

-- * 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"