dyre 0.4 → 0.5

raw patch · 3 files changed

+77/−37 lines, 3 filesdep +binaryPVP ok

version bump matches the API change (PVP)

Dependencies added: binary

API changes (from Hackage documentation)

Files

• Config/Dyre.hs +3/−3
• Config/Dyre/Relaunch.hs +71/−31
• dyre.cabal +3/−3

@@ -39,7 +39,7 @@ >showError cfg msg = cfg { errorMsg = Just msg } > >realMain Config{message = message, errorMsg = errorMsg } = do->    (State buffer) <- restoreState $ State []+>    (State buffer) <- restoreTextState $ State [] >    case errorMsg of >         Nothing -> return () >         Just em -> putStrLn $ "Error: " ++ em@@ -50,7 +50,7 @@ >    case input of >         "exit" -> return () >         "quit" -> return ()->         other  -> relaunchWithState (State $ other:buffer) Nothing+>         other  -> relaunchWithTextState (State $ other:buffer) Nothing > >dyreExample = Dyre.wrapMain $ Dyre.defaultParams >    { Dyre.projectName = "dyreExample"@@ -114,7 +114,7 @@     }  -- | 'wrapMain' is how Dyre recieves control of the program. It is expected---   that it will be partially applied with its parameters to yield a "main"+--   that it will be partially applied with its parameters to yield a 'main' --   entry point, which will then be called by the 'main' function, as well --   as by any custom configurations. wrapMain :: Params cfgType -> cfgType -> IO ()

@@ -10,16 +10,27 @@ 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-  ( relaunchWithState-  , restoreState-  , relaunchMaster-  , maybeRestoreState+  ( relaunchMaster+  , relaunchWithTextState+  , relaunchWithBinaryState+  , saveTextState+  , saveBinaryState+  , restoreTextState+  , restoreBinaryState   ) where  import Data.Maybe           ( fromMaybe, fromJust ) import System.IO            ( writeFile, readFile )+import Data.Binary          ( Binary, encodeFile, decodeFile ) import System.IO.Error      ( try ) import System.FilePath      ( (</>) ) import System.Directory     ( getTemporaryDirectory, removeFile )@@ -29,48 +40,77 @@ import Config.Dyre.Compat   ( customExec, getPIDString )  -- | Just relaunch the master binary. We don't have any important---   state to worry about. (Or, like when 'relaunchWithState' calls---   it, we're managing state on our own.)+--   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 'getArgs' will be used. relaunchMaster :: Maybe [String] -> IO () relaunchMaster otherArgs = do     masterPath <- fmap fromJust getMasterBinary     customExec masterPath otherArgs  -- | Relaunch the master binary, but first preserve the program---   state so that we can use the 'restoreState' functions to get---   it back again later. Since we're not trying to be fancy here,---   we'll just use 'show' to write it out.-relaunchWithState :: Show a => a -> Maybe [String] -> IO ()-relaunchWithState state otherArgs = do-    -- Calculate the path to the state file+--   state so that we can use the 'restoreTextState' functions to+--   get it back again later.+relaunchWithTextState :: Show a => a -> Maybe [String] -> IO ()+relaunchWithTextState state otherArgs = do+    saveTextState state+    relaunchMaster otherArgs++-- | Serialize the state for later restoration with 'restoreBinaryState',+--   and then relaunch the master binary.+relaunchWithBinaryState :: Binary a => a -> Maybe [String] -> IO ()+relaunchWithBinaryState state otherArgs = do+    saveBinaryState state+    relaunchMaster 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 = do     pidString <- getPIDString     tempDir   <- getTemporaryDirectory     let statePath = tempDir </> pidString ++ ".state"-    -- Write the state to the file and store the path-    writeFile statePath . show $ state     putValue "dyre" "persistState" statePath-    -- Relaunch-    relaunchMaster otherArgs+    return statePath --- | Restore state that was previously saved by the 'relaunchWithState'---   function. If unsuccessful, it will simply return Nothing.-maybeRestoreState :: Read a => IO (Maybe a)--- This could probably be a lot simpler if I grokked--- monad transformers better.-maybeRestoreState = do+-- | Serialize a state as text, for later loading with the+--   'restoreTextState' function.+saveTextState :: Show a => a -> IO ()+saveTextState state = do+    statePath <- genStatePath+    writeFile statePath . show $ state++-- | Serialize a state as binary data, for later loading with+--   the 'restoreBinaryState' function.+saveBinaryState :: Binary a => a -> IO ()+saveBinaryState state = do+    statePath <- genStatePath+    encodeFile statePath . Just $ 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 d = do     statePath <- getStatePersist     case statePath of-         Nothing -> return Nothing+         Nothing -> return d          Just sp -> do              stateData <- readFile sp---             removeFile sp-             delValue "dyre" "persistState"              result <- try $ readIO stateData              case result of-                  Left  _ -> return $ Nothing-                  Right v -> return $ Just v+                  Left  _ -> return d+                  Right v -> return v --- | Restore state using the 'maybeRestoreState' function, but return---   the provided default state if we can't get anything better.-restoreState :: Read a => a -> IO a-restoreState d = fmap (fromMaybe d) maybeRestoreState+-- | 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 d = do+    statePath <- getStatePersist+    case statePath of+         Nothing -> return d+         Just sp -> do state <- decodeFile sp+                       return $ fromMaybe d state

@@ -1,6 +1,6 @@ name:          dyre-version:       0.4-category:      Development+version:       0.5+category:      Development, Configuration synopsis:      Dynamic reconfiguration in Haskell  description:   Dyre implements dynamic reconfiguration facilities after the@@ -32,7 +32,7 @@                    Config.Dyre.Compile,                    Config.Dyre.Relaunch   build-depends:   base >= 4 && < 5, process, filepath,-                   directory, ghc-paths, old-time,+                   directory, ghc-paths, old-time, binary,                    executable-path, xdg-basedir, io-storage    if os(windows)