{-# LANGUAGE ScopedTypeVariables #-}

{- |

This is the only other module aside from "Config.Dyre" which needs
to be imported specially. It contains functions for restarting the
program (which, usefully, will cause a recompile if the config has
been changed), as well as saving and restoring state across said
restarts.

The impossibly simple function arguments are a consequence of a
little cheating we do using the "System.IO.Storage" library. Of
course, we can't use the stored data unless something else put
it there, so this module will probably explode horribly if used
outside of a program whose recompilation is managed by Dyre.

The functions for saving and loading state come in two variants:
one which uses the 'Read' and 'Show' typeclasses, and one which
uses "Data.Binary" to serialize it. The 'Read' and 'Show' versions
are much easier to use thanks to automatic deriving, but the
binary versions offer more control over saving and loading, as
well as probably being a bit faster.

-}
module Config.Dyre.Relaunch
  ( relaunchMaster
  , relaunchWithTextState
  , relaunchWithBinaryState
  , saveTextState
  , saveBinaryState
  , restoreTextState
  , restoreBinaryState
  ) where

import Data.Maybe           ( fromMaybe )
import System.IO            ( writeFile, readFile )
import Data.Binary          ( Binary, encodeFile, decodeFile )
import Control.Exception    ( try, SomeException )
import System.FilePath      ( (</>) )
import System.Directory     ( getTemporaryDirectory )

import System.IO.Storage    ( putValue )
import Config.Dyre.Options  ( getMasterBinary, getStatePersist )
import Config.Dyre.Compat   ( customExec, getPIDString )

-- | Just relaunch the master binary. We don't have any important
--   state to worry about. (Or, like when @relaunchWith\<X\>State@ calls
--   it, we're managing state on our own). It takes an argument which
--   can optionally specify a new set of arguments. If it is given a
--   value of 'Nothing', the current value of 'System.Environment.getArgs' will be used.
relaunchMaster :: Maybe [String] -> IO ()
relaunchMaster :: Maybe [String] -> IO ()
relaunchMaster Maybe [String]
otherArgs = do
    String
masterPath <- (Maybe String -> String) -> IO (Maybe String) -> IO String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe (String -> Maybe String -> String)
-> String -> Maybe String -> String
forall a b. (a -> b) -> a -> b
$ String -> String
forall a. HasCallStack => String -> a
error String
"'dyre' data-store doesn't exist (in Config.Dyre.Relaunch.relaunchMaster)") IO (Maybe String)
getMasterBinary
    String -> Maybe [String] -> IO ()
forall a. String -> Maybe [String] -> IO a
customExec String
masterPath Maybe [String]
otherArgs

-- | Relaunch the master binary, but first preserve the program
--   state so that we can use the 'restoreTextState' functions to
--   get it back again later.
relaunchWithTextState :: Show a => a -> Maybe [String] -> IO ()
relaunchWithTextState :: a -> Maybe [String] -> IO ()
relaunchWithTextState a
state Maybe [String]
otherArgs = do
    a -> IO ()
forall a. Show a => a -> IO ()
saveTextState a
state
    Maybe [String] -> IO ()
relaunchMaster Maybe [String]
otherArgs

-- | Serialize the state for later restoration with 'restoreBinaryState',
--   and then relaunch the master binary.
relaunchWithBinaryState :: Binary a => a -> Maybe [String] -> IO ()
relaunchWithBinaryState :: a -> Maybe [String] -> IO ()
relaunchWithBinaryState a
state Maybe [String]
otherArgs = do
    a -> IO ()
forall a. Binary a => a -> IO ()
saveBinaryState a
state
    Maybe [String] -> IO ()
relaunchMaster Maybe [String]
otherArgs

-- | Calculate the path that will be used for saving the state.
--   The path used to load the state, meanwhile, is passed to the
--   program with the '--dyre-persist-state=<path>' flag.
genStatePath :: IO FilePath
genStatePath :: IO String
genStatePath = do
    String
pidString <- IO String
getPIDString
    String
tempDir   <- IO String
getTemporaryDirectory
    let statePath :: String
statePath = String
tempDir String -> String -> String
</> String
pidString String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".state"
    String -> String -> String -> IO ()
forall a. Typeable a => String -> String -> a -> IO ()
putValue String
"dyre" String
"persistState" String
statePath
    String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return String
statePath

-- | Serialize a state as text, for later loading with the
--   'restoreTextState' function.
saveTextState :: Show a => a -> IO ()
saveTextState :: a -> IO ()
saveTextState a
state = do
    String
statePath <- IO String
genStatePath
    String -> String -> IO ()
writeFile String
statePath (String -> IO ()) -> (a -> String) -> a -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
show (a -> IO ()) -> a -> IO ()
forall a b. (a -> b) -> a -> b
$ a
state

-- | Serialize a state as binary data, for later loading with
--   the 'restoreBinaryState' function.
saveBinaryState :: Binary a => a -> IO ()
saveBinaryState :: a -> IO ()
saveBinaryState a
state = do
    String
statePath <- IO String
genStatePath
    String -> Maybe a -> IO ()
forall a. Binary a => String -> a -> IO ()
encodeFile String
statePath (Maybe a -> IO ()) -> (a -> Maybe a) -> a -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Maybe a
forall a. a -> Maybe a
Just (a -> IO ()) -> a -> IO ()
forall a b. (a -> b) -> a -> b
$ a
state

-- | Restore state which has been serialized through the
--   'saveTextState' function. Takes a default which is
--   returned if the state doesn't exist.
restoreTextState :: Read a => a -> IO a
restoreTextState :: a -> IO a
restoreTextState a
d = do
    Maybe String
statePath <- IO (Maybe String)
getStatePersist
    case Maybe String
statePath of
         Maybe String
Nothing -> a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
d
         Just String
sp -> do
             String
stateData <- String -> IO String
readFile String
sp
             Either SomeException a
result <- IO a -> IO (Either SomeException a)
forall e a. Exception e => IO a -> IO (Either e a)
try (IO a -> IO (Either SomeException a))
-> IO a -> IO (Either SomeException a)
forall a b. (a -> b) -> a -> b
$ String -> IO a
forall a. Read a => String -> IO a
readIO String
stateData
             case Either SomeException a
result of
                  Left  (SomeException
_ :: SomeException) -> a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
d
                  Right                    a
v -> a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
v

-- | Restore state which has been serialized through the
--   'saveBinaryState' function. Takes a default which is
--   returned if the state doesn't exist.
restoreBinaryState :: Binary a => a -> IO a
restoreBinaryState :: a -> IO a
restoreBinaryState a
d = do
    Maybe String
statePath <- IO (Maybe String)
getStatePersist
    case Maybe String
statePath of
         Maybe String
Nothing -> a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
d
         Just String
sp -> do Maybe a
state <- String -> IO (Maybe a)
forall a. Binary a => String -> IO a
decodeFile String
sp
                       a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> IO a) -> a -> IO a
forall a b. (a -> b) -> a -> b
$ a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe a
d Maybe a
state