{-# LANGUAGE ScopedTypeVariables #-}
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 )
relaunchMaster :: Maybe [String] -> IO ()
relaunchMaster :: Maybe [FilePath] -> IO ()
relaunchMaster Maybe [FilePath]
otherArgs = do
FilePath
masterPath <- (Maybe FilePath -> FilePath) -> IO (Maybe FilePath) -> IO FilePath
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (FilePath -> Maybe FilePath -> FilePath
forall a. a -> Maybe a -> a
fromMaybe (FilePath -> Maybe FilePath -> FilePath)
-> FilePath -> Maybe FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath
forall a. HasCallStack => FilePath -> a
error FilePath
"'dyre' data-store doesn't exist (in Config.Dyre.Relaunch.relaunchMaster)") IO (Maybe FilePath)
getMasterBinary
FilePath -> Maybe [FilePath] -> IO ()
forall a. FilePath -> Maybe [FilePath] -> IO a
customExec FilePath
masterPath Maybe [FilePath]
otherArgs
relaunchWithTextState :: Show a => a -> Maybe [String] -> IO ()
relaunchWithTextState :: forall a. Show a => a -> Maybe [FilePath] -> IO ()
relaunchWithTextState a
state Maybe [FilePath]
otherArgs = do
a -> IO ()
forall a. Show a => a -> IO ()
saveTextState a
state
Maybe [FilePath] -> IO ()
relaunchMaster Maybe [FilePath]
otherArgs
relaunchWithBinaryState :: Binary a => a -> Maybe [String] -> IO ()
relaunchWithBinaryState :: forall a. Binary a => a -> Maybe [FilePath] -> IO ()
relaunchWithBinaryState a
state Maybe [FilePath]
otherArgs = do
a -> IO ()
forall a. Binary a => a -> IO ()
saveBinaryState a
state
Maybe [FilePath] -> IO ()
relaunchMaster Maybe [FilePath]
otherArgs
genStatePath :: IO FilePath
genStatePath :: IO FilePath
genStatePath = do
FilePath
pidString <- IO FilePath
getPIDString
FilePath
tempDir <- IO FilePath
getTemporaryDirectory
let statePath :: FilePath
statePath = FilePath
tempDir FilePath -> FilePath -> FilePath
</> FilePath
pidString FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
".state"
FilePath -> FilePath -> FilePath -> IO ()
forall a. Typeable a => FilePath -> FilePath -> a -> IO ()
putValue FilePath
"dyre" FilePath
"persistState" FilePath
statePath
FilePath -> IO FilePath
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
statePath
saveTextState :: Show a => a -> IO ()
saveTextState :: forall a. Show a => a -> IO ()
saveTextState a
state = do
FilePath
statePath <- IO FilePath
genStatePath
FilePath -> FilePath -> IO ()
writeFile FilePath
statePath (FilePath -> IO ()) -> (a -> FilePath) -> a -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> FilePath
forall a. Show a => a -> FilePath
show (a -> IO ()) -> a -> IO ()
forall a b. (a -> b) -> a -> b
$ a
state
saveBinaryState :: Binary a => a -> IO ()
saveBinaryState :: forall a. Binary a => a -> IO ()
saveBinaryState a
state = do
FilePath
statePath <- IO FilePath
genStatePath
FilePath -> Maybe a -> IO ()
forall a. Binary a => FilePath -> a -> IO ()
encodeFile FilePath
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
restoreTextState :: Read a => a -> IO a
restoreTextState :: forall a. Read a => a -> IO a
restoreTextState a
d = do
Maybe FilePath
statePath <- IO (Maybe FilePath)
getStatePersist
case Maybe FilePath
statePath of
Maybe FilePath
Nothing -> a -> IO a
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
d
Just FilePath
sp -> do
FilePath
stateData <- FilePath -> IO FilePath
readFile FilePath
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
$ FilePath -> IO a
forall a. Read a => FilePath -> IO a
readIO FilePath
stateData
case Either SomeException a
result of
Left (SomeException
_ :: SomeException) -> a -> IO a
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
d
Right a
v -> a -> IO a
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
v
restoreBinaryState :: Binary a => a -> IO a
restoreBinaryState :: forall a. Binary a => a -> IO a
restoreBinaryState a
d = do
Maybe FilePath
statePath <- IO (Maybe FilePath)
getStatePersist
case Maybe FilePath
statePath of
Maybe FilePath
Nothing -> a -> IO a
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
d
Just FilePath
sp -> do Maybe a
state <- FilePath -> IO (Maybe a)
forall a. Binary a => FilePath -> IO a
decodeFile FilePath
sp
a -> IO a
forall a. 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