dyre 0.8.0 → 0.8.2
raw patch · 11 files changed
+75/−69 lines, 11 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
Files
- Config/Dyre.hs +52/−49
- Config/Dyre/Compat.hs +5/−2
- Config/Dyre/Compile.hs +4/−4
- Config/Dyre/Options.hs +1/−1
- Config/Dyre/Paths.hs +2/−2
- Tests/basic/BasicTest.hs +6/−9
- Tests/basic/badConfig.hs +1/−1
- Tests/basic/runTest.sh +1/−0
- Tests/config-check/runTest.sh +1/−0
- Tests/recompile-relaunch/runTest.sh +1/−0
- dyre.cabal +1/−1
Config/Dyre.hs view
@@ -20,50 +20,50 @@ A full example of using most of Dyre's major features is as follows: - -- DyreExample.hs --- module DyreExample where-- import qualified Config.Dyre as Dyre- import Config.Dyre.Relaunch-- import System.IO-- data Config = Config { message :: String, errorMsg :: Maybe String }- data State = State { bufferLines :: [String] } deriving (Read, Show)-- defaultConfig :: Config- defaultConfig = Config "Dyre Example v0.1" Nothing-- showError :: Config -> String -> Config- showError cfg msg = cfg { errorMsg = Just msg }-- realMain Config{message = message, errorMsg = errorMsg } = do- (State buffer) <- restoreTextState $ State []- case errorMsg of- Nothing -> return ()- Just em -> putStrLn $ "Error: " ++ em- putStrLn message- mapM putStrLn . reverse $ buffer- putStr "> " >> hFlush stdout- input <- getLine- case input of- "exit" -> return ()- "quit" -> return ()- other -> relaunchWithTextState (State $ other:buffer) Nothing-- dyreExample = Dyre.wrapMain $ Dyre.defaultParams- { Dyre.projectName = "dyreExample"- , Dyre.realMain = realMain- , Dyre.showError = showError- }+> -- DyreExample.hs --+> module DyreExample where+>+> import qualified Config.Dyre as Dyre+> import Config.Dyre.Relaunch+>+> import System.IO+>+> data Config = Config { message :: String, errorMsg :: Maybe String }+> data State = State { bufferLines :: [String] } deriving (Read, Show)+>+> defaultConfig :: Config+> defaultConfig = Config "Dyre Example v0.1" Nothing+>+> showError :: Config -> String -> Config+> showError cfg msg = cfg { errorMsg = Just msg }+>+> realMain Config{message = message, errorMsg = errorMsg } = do+> (State buffer) <- restoreTextState $ State []+> case errorMsg of+> Nothing -> return ()+> Just em -> putStrLn $ "Error: " ++ em+> putStrLn message+> mapM putStrLn . reverse $ buffer+> putStr "> " >> hFlush stdout+> input <- getLine+> case input of+> "exit" -> return ()+> "quit" -> return ()+> other -> relaunchWithTextState (State $ other:buffer) Nothing+>+> dyreExample = Dyre.wrapMain $ Dyre.defaultParams+> { Dyre.projectName = "dyreExample"+> , Dyre.realMain = realMain+> , Dyre.showError = showError+> } Notice that all of the program logic is contained in the 'DyreExample' module. The main module of the program is absolutely trivial, being essentially just the default configuration for the program: - -- Main.hs --- import DyreExample- main = dyreExample defaultConfig+> -- Main.hs --+> import DyreExample+> main = dyreExample defaultConfig When reading the above program, notice that the majority of the code is simply *program logic*. Dyre is designed to intelligently@@ -87,6 +87,8 @@ import System.Directory ( doesFileExist, removeFile ) import System.Environment ( getArgs ) +import Control.Monad ( when )+ import Config.Dyre.Params ( Params(..) ) import Config.Dyre.Compile ( customCompile, getErrorPath, getErrorString ) import Config.Dyre.Compat ( customExec )@@ -114,7 +116,7 @@ -- entry point, which will then be called by the 'main' function, as well -- as by any custom configurations. wrapMain :: Params cfgType -> cfgType -> IO ()-wrapMain params@Params{projectName = pName} cfg = withDyreOptions params $ do+wrapMain params@Params{projectName = pName} cfg = withDyreOptions params $ -- Allow the 'configCheck' parameter to disable all of Dyre's recompilation -- checks, in favor of simply proceeding ahead to the 'realMain' function. if not $ configCheck params@@ -127,18 +129,20 @@ thisTime <- maybeModTime thisBinary tempTime <- maybeModTime tempBinary confTime <- maybeModTime configFile- let confExists = confTime /= Nothing - -- If there's a config file, and the temp binary is older than something- -- else, or we were specially told to recompile, then we should recompile. denyReconf <- getDenyReconf forceReconf <- getForceReconf+ -- Either the user or timestamps indicate we need to recompile+ let needReconf = or [ tempTime < confTime+ , tempTime < thisTime+ , forceReconf+ ] - if not denyReconf && confExists &&- (tempTime < confTime || tempTime < thisTime || forceReconf)- then customCompile params- else return ()+ -- If we're allowed to reconfigure, a configuration exists, and+ -- we detect a need to recompile it, then go ahead and compile.+ when (not denyReconf && confExists && needReconf)+ (customCompile params) -- If there's a custom binary and we're not it, run it. Otherwise -- just launch the main function, reporting errors if appropriate.@@ -165,7 +169,6 @@ -- Remove the error file if it exists errorFile <- getErrorPath params errorExists <- doesFileExist errorFile- if errorExists then removeFile errorFile- else return ()+ when errorExists $ removeFile errorFile -- Enter the main program realMain params mainConfig
Config/Dyre/Compat.hs view
@@ -1,5 +1,8 @@ {-# LANGUAGE CPP #-}++#if defined(mingw32_HOST_OS) || defined(__MINGW32__) {-# LANGUAGE ForeignFunctionInterface #-}+#endif {- | Compatibility code for things that need to be done differently@@ -54,8 +57,8 @@ #else -import System.Posix.Process ( executeFile, getProcessID )-import System.Posix.Process ( forkProcess, exitImmediately, getProcessStatus, ProcessStatus(..) )+import System.Posix.Process ( executeFile, getProcessID, exitImmediately+ , forkProcess, getProcessStatus, ProcessStatus(..) ) import System.Posix.Signals ( raiseSignal, sigTSTP ) import System.Exit ( ExitCode(..) )
Config/Dyre/Compile.hs view
@@ -53,8 +53,8 @@ -- Display a helpful little status message if result /= ExitSuccess- then output $ "Error occurred while loading configuration file."- else output $ "Program reconfiguration successful."+ then output "Error occurred while loading configuration file."+ else output "Program reconfiguration successful." -- | Assemble the arguments to GHC so everything compiles right. makeFlags :: Params cfgType -> FilePath -> FilePath -> FilePath -> IO [String]@@ -65,6 +65,6 @@ , ["-outputdir", cacheDir] , prefix "-hide-package" hides, flags , ["--make", cfgFile, "-o", tmpFile]- , if force then ["-fforce-recomp"] else []+ , ["-fforce-recomp" | force] -- Only if force is true ]- where prefix y xs = concat . map (\x -> [y,x]) $ xs+ where prefix y = concatMap $ \x -> [y,x]
Config/Dyre/Options.hs view
@@ -111,7 +111,7 @@ , case stateFile of Nothing -> "" Just sf -> "--dyre-state-persist=" ++ sf- , "--dyre-master-binary=" ++ (fromJust masterPath)+ , "--dyre-master-binary=" ++ fromJust masterPath ] return args
Config/Dyre/Paths.hs view
@@ -22,12 +22,12 @@ (False, Nothing) -> getUserCacheDir pName (False, Just cd) -> cd configDir <- case (debugMode, configDir params) of- (True, _ ) -> return $ cwd+ (True, _ ) -> return cwd (False, Nothing) -> getUserConfigDir pName (False, Just cd) -> cd let tempBinary = cacheDir </> pName ++ "-" ++ os ++ "-" ++ arch let configFile = configDir </> pName ++ ".hs"- return $ (thisBinary, tempBinary, configFile, cacheDir)+ return (thisBinary, tempBinary, configFile, cacheDir) -- | Check if a file exists. If it exists, return Just the modification -- time. If it doesn't exist, return Nothing.
Tests/basic/BasicTest.hs view
@@ -3,6 +3,7 @@ import qualified Config.Dyre as Dyre import Config.Dyre.Relaunch+import Control.Monad import System.IO data Config = Config { message :: String, errorMsg :: Maybe String }@@ -13,15 +14,11 @@ showError :: Config -> String -> Config showError cfg msg = cfg { errorMsg = Just msg } -realMain Config{message = message, errorMsg = errorMsg } = do- case errorMsg of- Just em -> putStrLn "Compile Error"- Nothing -> do- state <- restoreTextState 1- if state < 3- then relaunchWithTextState (state + 1) Nothing- else return ()- putStrLn $ message ++ " - " ++ show state+realMain (Config message (Just err)) = putStrLn "Compile Error"+realMain (Config message Nothing) = do+ state <- restoreTextState 1+ when (state < 3) $ relaunchWithTextState (state + 1) Nothing+ putStrLn $ message ++ " - " ++ show state basicTest = Dyre.wrapMain $ Dyre.defaultParams { Dyre.projectName = "basicTest"
Tests/basic/badConfig.hs view
@@ -1,2 +1,2 @@ import BasicTest-main = basicTest $ defaultConfig { message = "Basic Test Version 3.0 }+main = basicTest $ defaultConfig { massage = "Basic Test Version 3.0" }
Tests/basic/runTest.sh view
@@ -8,6 +8,7 @@ # Assert the equality of two strings. function assert() {+ echo "$1" >&2 if [ "$1" != "$2" ]; then echo "Failed test $3"; exit 1;
Tests/config-check/runTest.sh view
@@ -5,6 +5,7 @@ # Assert the equality of two strings. function assert() {+ echo "$1" >&2 if [ "$1" != "$2" ]; then echo "Failed test $3"; exit 1;
Tests/recompile-relaunch/runTest.sh view
@@ -5,6 +5,7 @@ # Assert the equality of two strings. function assert() {+ echo "$1" >&2 if [ "$1" != "$2" ]; then echo "Failed test $3"; exit 1;
dyre.cabal view
@@ -1,5 +1,5 @@ name: dyre-version: 0.8.0+version: 0.8.2 category: Development, Configuration synopsis: Dynamic reconfiguration in Haskell