dyre 0.7.3 → 0.8.0

raw patch · 20 files changed

+351/−94 lines, 20 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• Config/Dyre.hs +90/−75
• Config/Dyre/Compile.hs +22/−13
• Config/Dyre/Options.hs +13/−5
• Tests/README.mkd +11/−0
• Tests/allTests.sh +16/−0
• Tests/basic/BasicTest.hs +31/−0
• Tests/basic/Main.hs +2/−0
• Tests/basic/badConfig.hs +2/−0
• Tests/basic/goodConfig.hs +2/−0
• Tests/basic/runTest.sh +41/−0
• Tests/config-check/ConfigCheckTest.hs +19/−0
• Tests/config-check/Main.hs +2/−0
• Tests/config-check/configCheckTestA.hs +2/−0
• Tests/config-check/configCheckTestB.hs +2/−0
• Tests/config-check/runTest.sh +34/−0
• Tests/recompile-relaunch/Main.hs +2/−0
• Tests/recompile-relaunch/RecompileRelaunchTest.hs +18/−0
• Tests/recompile-relaunch/recompileRelaunchTest.hs +2/−0
• Tests/recompile-relaunch/runTest.sh +29/−0
• dyre.cabal +11/−1

@@ -18,89 +18,83 @@ but it has no impact whatsoever on the rest of the library whether it is used or not. -A full example of using Dyre's recompilation and relaunching features-is as follows:+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.+module. The main module of the program is absolutely trivial, being+essentially just the default configuration for the program: ->-- Main.hs --->module Main where->import DyreExample->main = dyreExample defaultConfig+    -- Main.hs --+    import DyreExample+    main = dyreExample defaultConfig -When reading the above program, bear in mind exactly how much of the+When reading the above program, notice that the majority of the code is simply *program logic*. Dyre is designed to intelligently-handle recompilation with a bare minimum of program modification.+handle recompilation with a minimum of programmer work.  Some mention should be made of Dyre's defaults. The 'defaultParams' structure used in the example defines reasonable default values for-several configuration items. In the absence of any other definitions,-Dyre will default to outputting status messages to stderr, not hiding-any packages during compilation, and passing no special options to GHC.+most configuration items. The three elements defined above are the+only elements that must be overridden. For documentation of the+parameters, consult the 'Config.Dyre.Params' module. -Also, Dyre will expect configuration files to be placed at the path-'$XDG_CONFIG_HOME/<app>/<app>.hs', and it will store cache files in-the '$XDG_CACHE_HOME/<app>/' directory. The 'System.Environment.XDG'-module will be used to determine these paths, so refer to it for-behaviour on Windows platforms.+In the absence of any customization, Dyre will search for configuration+files in '$XDG_CONFIG_HOME/<appName>/<appName>.hs', and will store+cache files in '$XDG_CACHE_HOME/<appName>/' directory. The module+'System.Environment.XDG' is used for this purpose, which also provides+analogous behaviour on Windows. -} module Config.Dyre ( wrapMain, Params(..), defaultParams ) where  import System.IO           ( hPutStrLn, stderr )-import System.Directory    ( doesFileExist )+import System.Directory    ( doesFileExist, removeFile )+import System.Environment  ( getArgs )  import Config.Dyre.Params  ( Params(..) )-import Config.Dyre.Compile ( customCompile )+import Config.Dyre.Compile ( customCompile, getErrorPath, getErrorString ) import Config.Dyre.Compat  ( customExec )-import Config.Dyre.Options ( getReconf, getDebug, withDyreOptions )+import Config.Dyre.Options ( getForceReconf, getDenyReconf, getDebug, withDyreOptions ) import Config.Dyre.Paths   ( getPaths, maybeModTime ) --- | A set of reasonable defaults for configuring Dyre. If the minimal set of---   fields are modified, the program will use the XDG-defined locations for---   configuration and cache files (see 'System.Environment.XDG.BaseDir' for---   details), pass no special options to GHC, and will output status messages---   to stderr.------   The fields that will have to be filled are 'projectName', 'realMain', and---   'showError'+-- | A set of reasonable defaults for configuring Dyre. The fields that+--   have to be filled are 'projectName', 'realMain', and 'showError'. defaultParams :: Params cfgType defaultParams = Params     { projectName  = undefined@@ -134,23 +128,44 @@         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.-        let confExists = confTime /= Nothing-        forceReconf <- getReconf-        errors <- if confExists &&-                     (tempTime < confTime || tempTime < thisTime || forceReconf)-                     then customCompile params-                     else return Nothing+        denyReconf  <- getDenyReconf+        forceReconf <- getForceReconf +        if not denyReconf && confExists &&+           (tempTime < confTime || tempTime < thisTime || forceReconf)+           then customCompile params+           else return ()+         -- If there's a custom binary and we're not it, run it. Otherwise         -- just launch the main function, reporting errors if appropriate.         -- Also we don't want to use a custom binary if the conf file is         -- gone.+        errorData    <- getErrorString params         customExists <- doesFileExist tempBinary         if confExists && customExists && (thisBinary /= tempBinary)-           then do statusOut params $ "Launching custom binary '" ++ tempBinary ++ "'\n"-                   customExec tempBinary Nothing-           else realMain params $ case errors of-                                       Nothing -> cfg-                                       Just er -> (showError params) cfg er+           then launchSub errorData tempBinary+           else enterMain errorData+  where launchSub errorData tempBinary = do+            statusOut params $ "Launching custom binary " ++ tempBinary ++ "\n"+            -- Deny reconfiguration if a compile already failed.+            arguments <- case errorData of+                Nothing -> getArgs+                Just _  -> ("--deny-reconf":) `fmap` getArgs+            -- Execute+            customExec tempBinary $ Just arguments+        enterMain errorData = do+            -- Show the error data if necessary+            let mainConfig = case errorData of+                                  Nothing -> cfg+                                  Just ed -> showError params cfg ed+            -- Remove the error file if it exists+            errorFile <- getErrorPath params+            errorExists <- doesFileExist errorFile+            if errorExists then removeFile errorFile+                           else return ()+            -- Enter the main program+            realMain params mainConfig

@@ -2,7 +2,7 @@ Compiling the custom executable. The majority of the code actually deals with error handling, and not the compilation itself /per se/. -}-module Config.Dyre.Compile ( customCompile ) where+module Config.Dyre.Compile ( customCompile, getErrorPath, getErrorString ) where  import System.IO         ( openFile, hClose, IOMode(..) ) import System.Exit       ( ExitCode(..) )@@ -16,16 +16,35 @@ import Config.Dyre.Paths  ( getPaths ) import Config.Dyre.Params ( Params(..) ) +-- | Return the path to the error file.+getErrorPath :: Params cfgType -> IO FilePath+getErrorPath params = do+    (_,_,_, cacheDir) <- getPaths params+    return $ cacheDir </> "errors.log"++-- | If the error file exists and actually has some contents, return+--   'Just' the error string. Otherwise return 'Nothing'.+getErrorString :: Params cfgType -> IO (Maybe String)+getErrorString params = do+    errorPath   <- getErrorPath params+    errorsExist <- doesFileExist errorPath+    if not errorsExist+       then return Nothing+       else do errorData <- readFile errorPath+               if errorData == ""+                  then return Nothing+                  else return . Just $ errorData+ -- | Attempts to compile the configuration file. Will return a string --   containing any compiler output.-customCompile :: Params cfgType -> IO (Maybe String)+customCompile :: Params cfgType -> IO () customCompile params@Params{statusOut = output} = do     (thisBinary, tempBinary, configFile, cacheDir) <- getPaths params     output $ "Configuration '" ++ configFile ++  "' changed. Recompiling."     createDirectoryIfMissing True cacheDir      -- Compile occurs in here-    let errFile = cacheDir </> "errors.log"+    errFile <- getErrorPath params     result <- bracket (openFile errFile WriteMode) hClose $ \errHandle -> do         ghcOpts <- makeFlags params configFile tempBinary cacheDir         ghcProc <- runProcess ghc ghcOpts (Just cacheDir) Nothing@@ -36,16 +55,6 @@     if result /= ExitSuccess        then output $ "Error occurred while loading configuration file."        else output $ "Program reconfiguration successful."--    -- If the error file exists and actually has some contents, return-    -- 'Just' the error string. Otherwise return 'Nothing'.-    errorsExist <- doesFileExist errFile-    if not errorsExist-       then return Nothing-       else do errors <- readFile errFile-               if errors == ""-                  then return Nothing-                  else return . Just $ errors  -- | Assemble the arguments to GHC so everything compiles right. makeFlags :: Params cfgType -> FilePath -> FilePath -> FilePath -> IO [String]

@@ -19,7 +19,8 @@ module Config.Dyre.Options   ( withDyreOptions   , customOptions-  , getReconf+  , getDenyReconf+  , getForceReconf   , getDebug   , getMasterBinary   , getStatePersist@@ -52,6 +53,7 @@     -- Load the other important arguments into IO storage.     storeFlag args "--dyre-state-persist=" "persistState"     putValue "dyre" "forceReconf"  $ "--force-reconf" `elem` args+    putValue "dyre" "denyReconf"   $ "--deny-reconf"  `elem` args     putValue "dyre" "debugMode"    $ "--dyre-debug"   `elem` args      -- We filter the arguments, so now Dyre's arguments 'vanish'@@ -61,9 +63,14 @@  -- | Get the value of the '--force-reconf' flag, which is used --   to force a recompile of the custom configuration.-getReconf :: IO Bool-getReconf = getDefaultValue "dyre" "forceReconf" False+getForceReconf :: IO Bool+getForceReconf = getDefaultValue "dyre" "forceReconf" False +-- | Get the value of the '--deny-reconf' flag, which disables+--   recompilation. This overrides "--force-reconf", too.+getDenyReconf :: IO Bool+getDenyReconf = getDefaultValue "dyre" "denyReconf" False+ -- | Get the value of the '--dyre-debug' flag, which is used --   to debug a program without installation. Specifically, --   it forces the application to use './cache/' as the cache@@ -119,5 +126,6 @@ -- | The array of all arguments that Dyre recognizes. Used to --   make sure none of them are visible past 'withDyreOptions' dyreArgs :: [String]-dyreArgs = [ "--force-reconf", "--dyre-state-persist"-           , "--dyre-debug", "--dyre-master-binary" ]+dyreArgs = [ "--force-reconf", "--deny-reconf"+           , "--dyre-state-persist", "--dyre-debug"+           , "--dyre-master-binary" ]

@@ -0,0 +1,11 @@+Dyre Test Suite+===============++It's hard to design an automated testing system which can cope with a+program that recompiles itself on the fly, much less test the logic+behind those recompilations.++As a result, Dyre's tests are very high-level. They consist of a set of+source files and a shell script which will compile and run the resulting+binary. Test success is determined entirely based on the output of the+programs.

@@ -0,0 +1,16 @@+#!/bin/sh++# Run all test scripts for Dyre.++for TESTDIR in `find . -mindepth 1 -type d`; do+    cd $TESTDIR+    TEST_RESULT=`./runTest.sh`+    if [ "$TEST_RESULT" != 'Passed' ]; then+        echo "$TEST_RESULT in test $TESTDIR"+        rm -r working+        exit 1+    fi+    cd ..+done++echo 'Passed'

@@ -0,0 +1,31 @@+module BasicTest where++import qualified Config.Dyre as Dyre++import Config.Dyre.Relaunch+import System.IO++data Config = Config { message :: String, errorMsg :: Maybe String }++defaultConfig :: Config+defaultConfig = Config "Basic Test Version 1.0" Nothing++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++basicTest = Dyre.wrapMain $ Dyre.defaultParams+    { Dyre.projectName = "basicTest"+    , Dyre.realMain    = realMain+    , Dyre.showError   = showError+    , Dyre.statusOut   = const . return $ ()+    }

@@ -0,0 +1,2 @@+import BasicTest+main = basicTest defaultConfig

@@ -0,0 +1,2 @@+import BasicTest+main = basicTest $ defaultConfig { message = "Basic Test Version 3.0 }

@@ -0,0 +1,2 @@+import BasicTest+main = basicTest $ defaultConfig { message = "Basic Test Version 2.0" }

@@ -0,0 +1,41 @@+#!/bin/sh++# Tests basic compiling and running.+# Tests state persistence across restarts.+# Tests custom configuration recompilation.+# Tests restarting a custom configuration.+# Tests compilation error reporting.++# Assert the equality of two strings.+function assert() {+    if [ "$1" != "$2" ]; then+        echo "Failed test $3";+        exit 1;+    fi+}++### SETUP ###+mkdir working+cd working++### TEST A ###+cp ../BasicTest.hs ../Main.hs .+ghc --make Main.hs -o basic 2> /dev/null+OUTPUT_A=`./basic --dyre-debug`+assert "$OUTPUT_A" "Basic Test Version 1.0 - 3" "A"++### TEST B ###+cp ../goodConfig.hs basicTest.hs+OUTPUT_B=`./basic --dyre-debug`+assert "$OUTPUT_B" "Basic Test Version 2.0 - 3" "B"++### TEST C ###+sleep 1+cp ../badConfig.hs basicTest.hs+OUTPUT_C=`./basic --dyre-debug`+assert "$OUTPUT_C" "Compile Error" "C"++### TEARDOWN ###+echo "Passed"+cd ..+rm -r working

@@ -0,0 +1,19 @@+module ConfigCheckTest where++import qualified Config.Dyre as Dyre+import System.IO++configCheckMain = Dyre.wrapMain $ Dyre.defaultParams+    { Dyre.projectName = "configCheckTest"+    , Dyre.realMain    = putStrLn+    , Dyre.showError   = const+    , Dyre.statusOut   = const . return $ ()+    }++configCheckTest = Dyre.wrapMain $ Dyre.defaultParams+    { Dyre.projectName = "configCheckTest"+    , Dyre.realMain    = putStrLn+    , Dyre.showError   = const+    , Dyre.statusOut   = const . return $ ()+    , Dyre.configCheck = False+    }

@@ -0,0 +1,2 @@+import ConfigCheckTest+main = configCheckMain "main"

@@ -0,0 +1,2 @@+import ConfigCheckTest+main = configCheckTest "custom-a"

@@ -0,0 +1,2 @@+import ConfigCheckTest+main = configCheckTest "custom-b"

@@ -0,0 +1,34 @@+#!/bin/sh++# Tests Dyre's ability to recompile a custom configuration+# upon relaunch, and restore the state again after.++# Assert the equality of two strings.+function assert() {+    if [ "$1" != "$2" ]; then+        echo "Failed test $3";+        exit 1;+    fi+}++mkdir working+cd working++### TEST A ###+cp ../ConfigCheckTest.hs ../Main.hs .+cp ../configCheckTestA.hs ./configCheckTest.hs+ghc --make Main.hs -o configCheck 2> /dev/null+OUTPUT_A=`./configCheck --dyre-debug`+assert "$OUTPUT_A" "custom-a" "A"++sleep 1++### TEST B ###+cp ../configCheckTestB.hs ./configCheckTest.hs+mv cache/configCheckTest* configCheck+OUTPUT_B=`./configCheck --dyre-debug`+assert "$OUTPUT_B" "custom-a" "B"++echo "Passed"+cd ..+rm -r working

@@ -0,0 +1,2 @@+import RecompileRelaunchTest+main = recompileRelaunchTest "Testing.."

@@ -0,0 +1,18 @@+module RecompileRelaunchTest where++import qualified Config.Dyre as Dyre+import Config.Dyre.Relaunch+import System.IO++realMain message = do+    state <- restoreTextState False+    putStr message >> hFlush stdout+    if state then putStrLn ""+             else relaunchWithTextState True Nothing++recompileRelaunchTest = Dyre.wrapMain $ Dyre.defaultParams+    { Dyre.projectName = "recompileRelaunchTest"+    , Dyre.realMain    = realMain+    , Dyre.showError   = const+    , Dyre.statusOut   = const . return $ ()+    }

@@ -0,0 +1,2 @@+import RecompileRelaunchTest+main = recompileRelaunchTest "..Successful"

@@ -0,0 +1,29 @@+#!/bin/sh++# Tests Dyre's ability to recompile a custom configuration+# upon relaunch, and restore the state again after.++# Assert the equality of two strings.+function assert() {+    if [ "$1" != "$2" ]; then+        echo "Failed test $3";+        exit 1;+    fi+}++mkdir working+cd working++### TEST A ###+cp ../RecompileRelaunchTest.hs ../Main.hs ../recompileRelaunchTest.hs .+ghc --make Main.hs -o recompileRelaunch 2> /dev/null+OUTPUT_A=`./recompileRelaunch --dyre-debug --deny-reconf`+assert "$OUTPUT_A" "Testing....Successful" "A"++### TEST B ###+OUTPUT_B=`./recompileRelaunch --dyre-debug --deny-reconf`+assert "$OUTPUT_B" "..Successful..Successful" "B"++echo "Passed"+cd ..+rm -r working

@@ -1,5 +1,5 @@ name:          dyre-version:       0.7.3+version:       0.8.0 category:      Development, Configuration synopsis:      Dynamic reconfiguration in Haskell @@ -22,6 +22,16 @@  build-type:    Simple cabal-version: >= 1.6++extra-source-files:+    Tests/README.mkd+    Tests/allTests.sh+    Tests/basic/*.hs+    Tests/basic/*.sh+    Tests/config-check/*.hs+    Tests/config-check/*.sh+    Tests/recompile-relaunch/*.hs+    Tests/recompile-relaunch/*.sh  library   exposed-modules: Config.Dyre,