dyre-0.9.2/0000755000000000000000000000000007346545000010656 5ustar0000000000000000dyre-0.9.2/CHANGELOG.md0000644000000000000000000000606407346545000012475 0ustar0000000000000000# 0.9.2 - Support Cabal store in `$XDG_STATE_HOME/cabal/store`, which is the default location since cabal-install v3.10. - Fix Cabal store package-db detection when package name contains hyphen characters. - Recognise `NIX_GHC` environment variable for better support of Nix environments. `HC`, if set, takes precedence. # 0.9.1 - Tell GHC about the Cabal store package DB via the `-package-db` option. This fixes compilation with Cabal store-based executables. # 0.9.0 - `realMain` can now **return arbitrary types**. To support this change, `Params` got a new type variable. ```haskell -- before data Params cfgType wrapMain :: Params cfgType -> cfgType -> IO () -- after data Params cfgType a wrapMain :: Params cfgType a -> cfgType -> IO a ``` - `defaultParams`, which contains `undefined` fields, has been **deprecated** in favour of the new function `newParams`: ```haskell -- here be bottoms defaultParams :: Params cfg a -- celestial music playing newParams :: String -- ^ 'projectName' -> (cfg -> IO a) -- ^ 'realMain' function -> (cfg -> String -> cfg) -- ^ 'showError' function -> Params cfg a ``` `newParams` takes values for the three required fields, so program authors can clearly see what they have to do and are less likely to make a mistake. - **Cabal store support**: Users can add extra include dirs via the `includeDirs` field of `Params`. The program author just has to put the package's library directory in the new `includeDirs` field: ```haskell import Config.Dyre import Paths_myapp (getLibDir) realMain = … showError = … myapp cfg = do libdir <- getLibDir let params = (newParams "myapp" realMain showError) { includeDirs = [libdir] } wrapMain params cfg ``` If an include dir appears to be in a Cabal store and matches the `projectName`, Dyre adds the corresponding `-package-id` option. As a result, recompilation works for programs installed via `cabal install`. - **Stack support**: if Dyre detects a `stack.yaml` alongside the custom configuration, it will use Stack to compile the program. Credit to *Jaro Reinders* for this feature. - Dyre compiles the custom executable with **`-threaded`** when the main executable uses the threaded RTS. This means one less thing for program authors to remember (or forget) to do. - Dyre now **requires GHC >= 7.10**. - Improved **documentation**. - The **test suite** was expanded, and can now be executed via `cabal test`. - Dyre **cleans up** better after compilation (successful or unsuccesful), and behaves better when the custom configuration is removed. - Some versions of GHC write to standard error, even during a successful compilation. Dyre no longer treats this as a compilation failure, instead relying solely on GHC's exit status. - Dyre recognises the **`HC` environment variable**. If set, it will compile the program using the specified compiler. - Fixes for **Windows**, including working with recent versions of the *process* package. dyre-0.9.2/Config/0000755000000000000000000000000007346545000012063 5ustar0000000000000000dyre-0.9.2/Config/Dyre.hs0000644000000000000000000003102107346545000013317 0ustar0000000000000000{- | Dyre is a library for configuring your Haskell programs. Like Xmonad, programs configured with Dyre will look for a configuration file written in Haskell, which essentially defines a custom program configured exactly as the user wishes it to be. And since the configuration is written in Haskell, the user is free to do anything they might wish in the context of configuring the program. Dyre places emphasis on elegance of operation and ease of integration with existing applications. The 'wrapMain' function is the sole entry point for Dyre. When partially applied with a parameter structure, it wraps around the 'realMain' value from that structure, yielding an almost identical function which has been augmented with dynamic recompilation functionality. The "Config.Dyre.Relaunch" module provides the ability to restart the program (recompiling if applicable), and persist state across restarts, but it has no impact whatsoever on the rest of the library whether it is used or not. = Writing a program that uses Dyre The following example program uses most of Dyre's major features: @ -- DyreExample.hs -- module DyreExample ( Config(..) , defaultConfig , 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) <- 'Config.Dyre.Relaunch.restoreTextState' $ State [] case errorMsg of Nothing -> return () Just em -> putStrLn $ "Error: " ++ em putStrLn message traverse putStrLn . reverse $ buffer putStr "> " *> hFlush stdout input <- getLine case input of "exit" -> return () "quit" -> return () other -> 'Config.Dyre.Relaunch.relaunchWithTextState' (State $ other:buffer) Nothing dyreExample = Dyre.'Config.Dyre.wrapMain' $ Dyre.'Config.Dyre.newParams' "dyreExample" realMain showError @ All of the program logic is contained in the @DyreExample@ module. The module exports the 'Config' data type, a @defaultConfig@, and the @dyreExample@ function which, when applied to a 'Config', returns an @(IO a)@ value to be used as @main@. The @Main@ module of the program is trivial. All that is required is to apply @dyreExample@ to the default configuration: @ -- Main.hs -- import DyreExample main = dyreExample defaultConfig @ = Custom program configuration Users can create a custom configuration file that overrides some or all of the default configuration: @ -- ~\/.config\/dyreExample\/dyreExample.hs -- import DyreExample main = dyreExample $ defaultConfig { message = "Dyre Example v0.1 (Modified)" } @ When a program that uses Dyre starts, Dyre checks to see if a custom configuration exists. If so, it runs a custom executable. Dyre (re)compiles and caches the custom executable the first time it sees the custom config or whenever the custom config has changed. If a custom configuration grows large, you can extract parts of it into one or more files under @lib/@. For example: @ -- ~\/.config\/dyreExample\/dyreExample.hs -- import DyreExample import Message main = dyreExample $ defaultConfig { message = Message.msg } @ @ -- ~\/.config\/dyreExample\/lib/Message.hs -- module Message where msg = "Dyre Example v0.1 (Modified)" @ == Working with the Cabal store For a Dyre-enabled program to work when installed via @cabal install@, it needs to add its library directory as an extra include directory for compilation. The library /package name/ __must__ match the Dyre 'projectName' for this to work. For example: @ import Paths_dyreExample (getLibDir) dyreExample cfg = do libdir <- getLibDir let params = (Dyre.'Config.Dyre.newParams' "dyreExample" realMain showError) { Dyre.'Config.Dyre.includeDirs' = [libdir] } Dyre.'Config.Dyre.wrapMain' params cfg @ See also the Cabal . == Specifying the compiler If the compiler that Dyre should use is not available as @ghc@, set the @HC@ environment variable when running the main program: @ export HC=\/opt\/ghc\/$GHC_VERSION\/bin\/ghc dyreExample # Dyre will use $HC for recompilation @ = Configuring Dyre Program authors configure Dyre using the 'Params' type. This type controls Dyre's behaviour, not the main program logic (the example uses the @Config@ type for that). Use 'newParams' to construct a 'Params' value. The three arguments are: - /Application name/ (a @String@). This affects the names of files and directories that Dyre uses for config, cache and logging. - The /real main/ function of the program, which has type @(cfgType -> IO a)@. @cfgType@ is the main program config type, and @a@ is usually @()@. - The /show error/ function, which has type @(cfgType -> String -> cfgType)@. If compiling the custom program fails, Dyre uses this function to set the compiler output in the main program's configuration. The main program can then display the error string to the user, or handle it however the author sees fit. The 'Params' type has several other fields for modifying Dyre's behaviour. 'newParams' uses reasonable defaults, but behaviours you can change include: - Where to look for custom configuration ('configDir'). By default Dyre will look for @$XDG_CONFIG_HOME\/\\/\.hs@, - Where to cache the custom executable and other files ('cacheDir'). By default Dyre will use @$XDG_CACHE_HOME\/\\/@. - Extra options to pass to GHC when compiling the custom executable ('ghcOpts'). Default: none. See 'Params' for descriptions of all the fields. -} module Config.Dyre ( wrapMain , Params(..) , newParams , defaultParams ) where import System.IO ( hPutStrLn, stderr ) import System.Directory ( doesFileExist, canonicalizePath ) import System.Environment (getArgs) import GHC.Environment (getFullArgs) import Control.Exception (assert) import Control.Monad ( when ) import Config.Dyre.Params ( Params(..), RTSOptionHandling(..) ) import Config.Dyre.Compile ( customCompile, getErrorString ) import Config.Dyre.Compat ( customExec ) import Config.Dyre.Options ( getForceReconf, getDenyReconf , withDyreOptions ) import Config.Dyre.Paths ( getPathsConfig, customExecutable, runningExecutable, configFile , checkFilesModified ) -- | A set of reasonable defaults for configuring Dyre. The fields that -- have to be filled are 'projectName', 'realMain', and 'showError' -- (because their initial value is @undefined@). -- -- Deprecated in favour of 'newParams' which takes the required -- fields as arguments. -- defaultParams :: Params cfgType a defaultParams = Params { projectName = undefined , configCheck = True , configDir = Nothing , cacheDir = Nothing , realMain = undefined , showError = undefined , includeDirs = [] , hidePackages = [] , ghcOpts = [] , forceRecomp = True , statusOut = hPutStrLn stderr , rtsOptsHandling = RTSAppend [] , includeCurrentDirectory = True } {-# DEPRECATED defaultParams "Use 'newParams' instead" #-} -- | Construct a 'Params' with the required values as given, and -- reasonable defaults for everything else. -- newParams :: String -- ^ 'projectName' -> (cfg -> IO a) -- ^ 'realMain' function -> (cfg -> String -> cfg) -- ^ 'showError' function -> Params cfg a newParams name main err = defaultParams { projectName = name, realMain = main, showError = err } -- | @wrapMain@ is how Dyre receives control of the program. It is expected -- 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@ returns whatever value is returned by the @realMain@ function -- in the @params@ (if it returns at all). In the common case this is @()@ -- but you can use Dyre with any @IO@ action. -- wrapMain :: Params cfgType a -> cfgType -> IO a wrapMain params 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 then realMain params cfg else do -- Get the important paths paths <- getPathsConfig params let tempBinary = customExecutable paths thisBinary = runningExecutable paths confExists <- doesFileExist (configFile paths) denyReconf <- getDenyReconf forceReconf <- getForceReconf doReconf <- case (confExists, denyReconf, forceReconf) of (False, _, _) -> pure False -- no config file (_, True, _) -> pure False -- deny overrules force (_, _, True) -> pure True -- avoid timestamp/hash checks (_, _, False) -> checkFilesModified paths when doReconf (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. -- Also we don't want to use a custom binary if the conf file is -- gone. errorData <- getErrorString params customExists <- doesFileExist tempBinary case (confExists, customExists) of (False, _) -> -- There is no custom config. Ignore custom binary if present. -- Run main binary and ignore errors file. enterMain Nothing (True, True) -> do -- Canonicalize the paths for comparison to avoid symlinks -- throwing us off. We do it here instead of earlier because -- canonicalizePath throws an exception when the file is -- nonexistent. thisBinary' <- canonicalizePath thisBinary tempBinary' <- canonicalizePath tempBinary if thisBinary' /= tempBinary' then launchSub errorData tempBinary else enterMain errorData (True, False) -> -- Config exists, but no custom binary. -- Looks like compile failed; run main binary with error data. enterMain errorData where launchSub errorData tempBinary = do statusOut params $ "Launching custom binary " ++ tempBinary ++ "\n" givenArgs <- handleRTSOptions $ rtsOptsHandling params -- Deny reconfiguration if a compile already failed. let arguments = case errorData of Nothing -> givenArgs Just _ -> "--deny-reconf":givenArgs -- 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 -- Enter the main program realMain params mainConfig assertM :: Applicative f => Bool -> f () assertM b = assert b (pure ()) -- | Extract GHC runtime system arguments filterRTSArgs :: [String] -> [String] filterRTSArgs = filt False where filt _ [] = [] filt _ ("--RTS":_) = [] filt False ("+RTS" :rest) = filt True rest filt True ("-RTS" :rest) = filt False rest filt False (_ :rest) = filt False rest filt True (arg :rest) = arg:filt True rest --filt state args = error $ "Error filtering RTS arguments in state " ++ show state ++ " remaining arguments: " ++ show args editRTSOptions :: [String] -> RTSOptionHandling -> [String] editRTSOptions _ (RTSReplace ls) = ls editRTSOptions opts (RTSAppend ls) = opts ++ ls handleRTSOptions :: RTSOptionHandling -> IO [String] handleRTSOptions h = do fargs <- getFullArgs args <- getArgs let rtsArgs = editRTSOptions (filterRTSArgs fargs) h assertM $ "--RTS" `notElem` rtsArgs pure $ case rtsArgs of [] | "+RTS" `elem` args -> "--RTS":args | otherwise -> args -- cleaner output _ -> "+RTS" : rtsArgs ++ "--RTS" : args dyre-0.9.2/Config/Dyre/0000755000000000000000000000000007346545000012766 5ustar0000000000000000dyre-0.9.2/Config/Dyre/Compat.hs0000644000000000000000000000632507346545000014553 0ustar0000000000000000{-# LANGUAGE CPP #-} #if defined(mingw32_HOST_OS) || defined(__MINGW32__) {-# LANGUAGE ForeignFunctionInterface #-} #if defined(i386_HOST_ARCH) #define WINDOWS_CCONV stdcall #elif defined(x86_64_HOST_ARCH) #define WINDOWS_CCONV ccall #else #error Unknown mingw32 arch #endif #endif {- | Compatibility code for things that need to be done differently on different systems. -} module Config.Dyre.Compat ( customExec, getPIDString ) where import Config.Dyre.Options ( customOptions ) #if defined(mingw32_HOST_OS) || defined(__MINGW32__) -- Windows import System.Win32 import System.Process import System.Exit import System.Mem -- This can be removed as soon as a 'getProcessID' function -- gets added to 'System.Win32' foreign import WINDOWS_CCONV unsafe "winbase.h GetCurrentProcessId" c_GetCurrentProcessID :: IO DWORD getPIDString = fmap show c_GetCurrentProcessID customExec binary mArgs = do args <- customOptions mArgs -- This whole thing is a terrible, ugly hack. Since Windows -- is too braindead to provide an exec() system call for us -- to use, we simply create a new process that inherits -- the stdio handles. (_,_,_,child) <- createProcess $ proc binary args -- Do some garbage collection in an optimistic attempt to -- offset some of the memory we waste here. performGC -- And to prevent terminal apps from losing IO, we have to -- sit around waiting for the child to exit. -- -- 'exitWith' will flush stdout and stderr waitForProcess child >>= exitWith #else import System.Posix.Process ( executeFile, getProcessID ) #ifdef darwin_HOST_OS import System.Posix.Process ( exitImmediately , forkProcess, getProcessStatus, ProcessStatus(..) ) import System.Posix.Signals ( raiseSignal, sigTSTP ) import System.Exit ( ExitCode(ExitSuccess) ) -- OSX. In a threaded process execv fails with ENOTSUP. -- See http://uninformed.org/index.cgi?v=1&a=1&p=16. So it -- is necessary to fork _then_ exec. -- -- According to https://bugs.python.org/issue6800 this was -- fixed in OS X 10.6. But I guess we'll leave the workaround -- in place until there is a compelling reason to remove it. customExec binary mArgs = do args <- customOptions mArgs childPID <- forkProcess $ executeFile binary False args Nothing forever $ do childStatus <- getProcessStatus True True childPID case childStatus of Nothing -> error "executeFile: couldn't get child process status" Just (Exited code) -> exitImmediately code #if MIN_VERSION_unix(2,7,0) Just (Terminated _ _) -> exitImmediately ExitSuccess #else Just (Terminated _) -> exitImmediately ExitSuccess #endif Just (Stopped _) -> raiseSignal sigTSTP where forever a = a >> forever a #else -- Linux / BSD customExec binary mArgs = do args <- customOptions mArgs executeFile binary False args Nothing #endif getPIDString = fmap show getProcessID #endif -- | Called whenever execution needs to be transferred over to -- a different binary. customExec :: FilePath -> Maybe [String] -> IO a -- | What it says on the tin. Gets the current PID as a string. -- Used to determine the name for the state file during restarts. getPIDString :: IO String dyre-0.9.2/Config/Dyre/Compile.hs0000644000000000000000000001363307346545000014720 0ustar0000000000000000{- | 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, getErrorPath, getErrorString ) where import Control.Applicative ((<|>)) import Control.Concurrent ( rtsSupportsBoundThreads ) import Control.Monad (when) import Data.Maybe (fromMaybe) import Data.List (intercalate) import System.IO ( IOMode(WriteMode), withFile ) import System.Environment (lookupEnv) import System.Exit ( ExitCode(..) ) import System.Process ( runProcess, waitForProcess ) import System.FilePath ( (), dropTrailingPathSeparator, joinPath, splitPath, takeDirectory ) import System.Directory ( getCurrentDirectory, doesFileExist , createDirectoryIfMissing , renameFile, removeFile ) import Config.Dyre.Paths ( PathsConfig(..), getPathsConfig, outputExecutable ) import Config.Dyre.Params ( Params(..) ) -- | Return the path to the error file. getErrorPath :: Params cfgType a -> IO FilePath getErrorPath params = ( "errors.log") . cacheDirectory <$> getPathsConfig params -- | If the error file exists and actually has some contents, return -- 'Just' the error string. Otherwise return 'Nothing'. getErrorString :: Params cfgType a -> 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 a -> IO () customCompile params@Params{statusOut = output} = do paths <- getPathsConfig params let tempBinary = customExecutable paths outFile = outputExecutable tempBinary configFile' = configFile paths cacheDir' = cacheDirectory paths libsDir = libsDirectory paths output $ "Configuration '" ++ configFile' ++ "' changed. Recompiling." createDirectoryIfMissing True cacheDir' -- Compile occurs in here errFile <- getErrorPath params result <- withFile errFile WriteMode $ \errHandle -> do flags <- makeFlags params configFile' outFile cacheDir' libsDir stackYaml <- do let stackYamlPath = takeDirectory configFile' "stack.yaml" stackYamlExists <- doesFileExist stackYamlPath if stackYamlExists then return $ Just stackYamlPath else return Nothing hc' <- lookupEnv "HC" nix_ghc <- lookupEnv "NIX_GHC" let hc = fromMaybe "ghc" (hc' <|> nix_ghc) ghcProc <- maybe (runProcess hc flags (Just cacheDir') Nothing Nothing Nothing (Just errHandle)) (\stackYaml' -> runProcess "stack" ("ghc" : "--stack-yaml" : stackYaml' : "--" : flags) Nothing Nothing Nothing Nothing (Just errHandle)) stackYaml waitForProcess ghcProc case result of ExitSuccess -> do renameFile outFile tempBinary -- GHC sometimes prints to stderr, even on success. -- Other parts of dyre infer error if error file exists -- and is non-empty, so remove it. removeFileIfExists errFile output "Program reconfiguration successful." _ -> do removeFileIfExists tempBinary output "Error occurred while loading configuration file." -- | Assemble the arguments to GHC so everything compiles right. makeFlags :: Params cfgType a -> FilePath -> FilePath -> FilePath -> FilePath -> IO [String] makeFlags params cfgFile outFile cacheDir' libsDir = do currentDir <- getCurrentDirectory pure . concat $ [ ["-v0", "-i" ++ libsDir] , ["-i" ++ currentDir | includeCurrentDirectory params] , prefix "-hide-package" (hidePackages params) -- add extra include dirs , fmap ("-i" ++) (includeDirs params) , includeDirs params >>= getCabalStoreGhcArgs (projectName params) , ghcOpts params -- if the current process uses threaded RTS, -- also compile custom executable with -threaded , [ "-threaded" | rtsSupportsBoundThreads ] , ["--make", cfgFile, "-outputdir", cacheDir', "-o", outFile] , ["-fforce-recomp" | forceRecomp params] -- Only if force is true ] where prefix y = concatMap $ \x -> [y,x] -- | Given a path to lib dir, if it is a package in the Cabal -- store that matches the projectName, return GHC arguments -- to enable the Cabal store package database and expose the -- application's library package. -- getCabalStoreGhcArgs :: String -> FilePath -> [String] getCabalStoreGhcArgs proj = mkArgs . go . fmap dropTrailingPathSeparator . splitPath where go :: [String] -> Maybe (String {- unit-id -}, [String] {- package-db -}) go (dir : "store" : hc : unit : _) | dir `elem` [".cabal", "cabal" {- probably under $XDG_STATE_HOME -}] , pkgNameFromUnitId unit == Just proj = Just (unit, [dir, "store", hc, "package.db"]) go (h : t@(_cabal : _store : _hc : _unit : _)) = fmap (h:) <$> go t go _ = Nothing mkArgs Nothing = [] mkArgs (Just (unitId, pkgDb)) = ["-package-db", joinPath pkgDb, "-package-id", unitId] -- | Extract package name from a unit-id, or return @Nothing@ -- if the input does not look like a unit-id. -- pkgNameFromUnitId :: String -> Maybe String pkgNameFromUnitId = fmap (intercalate "-") . go . splitOn '-' where go [s,_,_] = Just [s] -- drop the version and hash go (s:rest) = (s:) <$> go rest go [] = Nothing splitOn :: (Eq a) => a -> [a] -> [[a]] splitOn a l = case span (/= a) l of (h, []) -> [h] (h, _ : t) -> h : splitOn a t removeFileIfExists :: FilePath -> IO () removeFileIfExists path = do exists <- doesFileExist path when exists $ removeFile path dyre-0.9.2/Config/Dyre/Options.hs0000644000000000000000000001314607346545000014762 0ustar0000000000000000{- | Handling for the command-line options that can be used to configure Dyre. As of the last count, there are four of them, and more are unlikely to be needed. The only one that a user should ever need to use is the @--force-reconf@ option, so the others all begin with @--dyre-@. At the start of the program, before anything else occurs, the 'withDyreOptions' function is used to hide Dyre's command-line options. They are loaded into the @IO@ monad using the module "System.IO.Storage". This keeps them safely out of the way of the user code and our own. Later, when Dyre needs to access the options, it does so through the accessor functions defined here. When it comes time to pass control over to a new binary, it gets an argument list which preserves the important flags with a call to 'customOptions'. -} module Config.Dyre.Options ( removeDyreOptions , withDyreOptions , customOptions , getDenyReconf , getForceReconf , getDebug , getMasterBinary , getStatePersist ) where import Data.List (isPrefixOf) import Data.Maybe (fromMaybe) import System.IO.Storage (withStore, putValue, getValue, getDefaultValue) import System.Environment (getArgs, getProgName, withArgs) import System.Environment.Executable (getExecutablePath) import Config.Dyre.Params -- | Remove all Dyre's options from the given commandline arguments. removeDyreOptions :: [String] -> [String] removeDyreOptions = filter $ not . prefixElem dyreArgs where prefixElem xs = or . zipWith ($) (map isPrefixOf xs) . repeat -- | Store Dyre's command-line options to the IO-Store "dyre", -- and then execute the provided IO action with all Dyre's -- options removed from the command-line arguments. withDyreOptions :: Params c r -> IO a -> IO a withDyreOptions Params{configCheck = check} action = withStore "dyre" $ do -- Pretty important args <- getArgs -- If the flag exists, it overrides the current file. Likewise, -- if it doesn't exist, we end up with the path to our current -- file. This seems like a sensible way to do it. -- Don't use 'getExecutablePath' if we're byassing the rest of Dyre. this <- if check then getExecutablePath else getProgName putValue "dyre" "masterBinary" this storeFlag args "--dyre-master-binary=" "masterBinary" -- 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' withArgs (removeDyreOptions args) action -- | Get the value of the @--force-reconf@ flag, which is used -- to force a recompile of the custom configuration. 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 -- directory, and @./@ as the configuration directory. getDebug :: IO Bool getDebug = getDefaultValue "dyre" "debugMode" False -- | Get the path to the master binary. This is set to the path of -- the /current/ binary unless the @--dyre-master-binary=@ flag -- is set. Obviously, we pass the @--dyre-master-binary=@ flag to -- the custom configured application from the master binary. getMasterBinary :: IO (Maybe String) getMasterBinary = getValue "dyre" "masterBinary" -- | Get the path to a persistent state file. This is set only when -- the @--dyre-state-persist=@ flag is passed to the program. It -- is used internally by "Config.Dyre.Relaunch" to save and restore -- state when relaunching the program. getStatePersist :: IO (Maybe String) getStatePersist = getValue "dyre" "persistState" -- | Return the set of options which will be passed to another instance -- of Dyre. Preserves the master binary, state file, and debug mode -- flags, but doesn't pass along the forced-recompile flag. Can be -- passed a set of other arguments to use, or it defaults to using -- the current arguments when passed 'Nothing'. customOptions :: Maybe [String] -> IO [String] customOptions otherArgs = do masterPath <- getMasterBinary stateFile <- getStatePersist debugMode <- getDebug mainArgs <- maybe getArgs pure otherArgs -- Combine the other arguments with the Dyre-specific ones pure $ mainArgs ++ concat [ ["--dyre-debug" | debugMode] , ["--dyre-state-persist=" ++ sf | Just sf <- [stateFile]] , [ "--dyre-master-binary=" ++ fromMaybe (error "'dyre' data-store doesn't exist (in Config.Dyre.Options.customOptions)") masterPath] ] -- | Look for the given flag in the argument array, and store -- its value under the given name if it exists. storeFlag :: [String] -> String -> String -> IO () storeFlag args flag name | null match = return () | otherwise = putValue "dyre" name $ drop (length flag) (head match) where match = filter (isPrefixOf flag) args -- | The array of all arguments that Dyre recognizes. Used to -- make sure none of them are visible past 'withDyreOptions' dyreArgs :: [String] dyreArgs = [ "--force-reconf", "--deny-reconf" , "--dyre-state-persist", "--dyre-debug" , "--dyre-master-binary" ] dyre-0.9.2/Config/Dyre/Params.hs0000644000000000000000000000573407346545000014556 0ustar0000000000000000{- | Defines the 'Params' datatype which Dyre uses to define all program-specific configuration data. Shouldn't be imported directly, as 'Config.Dyre' re-exports it. -} module Config.Dyre.Params ( Params(..), RTSOptionHandling(..) ) where -- | This structure is how all kinds of useful data is fed into Dyre. Of -- course, only the 'projectName', 'realMain', and 'showError' fields -- are really necessary. By using the set of default values provided -- as 'Config.Dyre.newParams', you can get all the benefits of -- using Dyre to configure your program in only five or six lines of -- code. data Params cfgType a = Params { projectName :: String -- ^ The name of the project. This needs to also be the name of -- the executable, and the name of the configuration file. , configCheck :: Bool -- ^ Should Dyre look for and attempt to compile custom configurations? -- Useful for creating program entry points that bypass Dyre's -- recompilation, for testing purposes. , configDir :: Maybe (IO FilePath) -- ^ The directory to look for a configuration file in. , cacheDir :: Maybe (IO FilePath) -- ^ The directory to store build files in, including the final -- generated executable. , realMain :: cfgType -> IO a -- ^ The main function of the program. When Dyre has completed -- all of its recompilation, it passes the configuration data -- to this function and gets out of the way. , showError :: cfgType -> String -> cfgType -- ^ This function is used to display error messages that occur -- during recompilation, by allowing the program to modify its -- initial configuration. , includeDirs :: [FilePath] -- ^ Optional extra include dirs to use during compilation. -- To support installation via cabal-install, include the -- path returned from @Paths_\.getLibDir@. , hidePackages :: [String] -- ^ Packages that need to be hidden during compilation , ghcOpts :: [String] -- ^ Miscellaneous GHC compilation settings go here , forceRecomp :: Bool -- ^ Should GHC be given the -fforce-recomp flag? , statusOut :: String -> IO () -- ^ A status output function. Will be called with messages -- when Dyre recompiles or launches anything. A good value -- is 'hPutStrLn stderr', assuming there is no pressing -- reason to not put messages on stderr. , rtsOptsHandling :: RTSOptionHandling -- ^ Whether to append, or replace GHC runtime system options -- with others. , includeCurrentDirectory :: Bool -- ^ Whether to add current directory to include list (set False to -- prevent name shadowing within project directory.) -- } -- | Specify additional or replacement GHC runtime system options data RTSOptionHandling = RTSReplace [String] -- ^ replaces RTS options with given list | RTSAppend [String] -- ^ merges given list with RTS options from command line (so that nothing is lost) dyre-0.9.2/Config/Dyre/Paths.hs0000644000000000000000000001015307346545000014401 0ustar0000000000000000{- | File paths of interest to Dyre, and related values. -} module Config.Dyre.Paths where import Control.Monad ( filterM ) import Data.List ( isSuffixOf ) import System.Info (os, arch) import System.FilePath ( (), (<.>), takeExtension, splitExtension ) import System.Directory ( doesDirectoryExist , doesFileExist , getCurrentDirectory , getDirectoryContents , getModificationTime ) import System.Environment.XDG.BaseDir (getUserCacheDir, getUserConfigDir) import System.Environment.Executable (getExecutablePath) import Data.Time import Config.Dyre.Params import Config.Dyre.Options -- | Data type to make it harder to confuse which path is which. data PathsConfig = PathsConfig { runningExecutable :: FilePath , customExecutable :: FilePath , configFile :: FilePath -- ^ Where Dyre looks for the custom configuration file. , libsDirectory :: FilePath -- ^ @/libs@. This directory gets added to the GHC -- include path during compilation, so use configurations can be -- split up into modules. Changes to files under this directory -- trigger recompilation. , cacheDirectory :: FilePath -- ^ Where the custom executable, object and interface files, errors -- file and other metadata get stored. } -- | Determine a file name for the compiler to write to, based on -- the 'customExecutable' path. -- outputExecutable :: FilePath -> FilePath outputExecutable path = let (base, ext) = splitExtension path in base <.> "tmp" <.> ext -- | Return a 'PathsConfig', which records the current binary, the custom -- binary, the config file, and the cache directory. getPaths :: Params c r -> IO (FilePath, FilePath, FilePath, FilePath, FilePath) getPaths params@Params{projectName = pName} = do thisBinary <- getExecutablePath debugMode <- getDebug cwd <- getCurrentDirectory cacheDir' <- case (debugMode, cacheDir params) of (True, _ ) -> return $ cwd "cache" (False, Nothing) -> getUserCacheDir pName (False, Just cd) -> cd confDir <- case (debugMode, configDir params) of (True, _ ) -> return cwd (False, Nothing) -> getUserConfigDir pName (False, Just cd) -> cd let tempBinary = cacheDir' pName ++ "-" ++ os ++ "-" ++ arch <.> takeExtension thisBinary configFile' = confDir pName ++ ".hs" libsDir = confDir "lib" pure (thisBinary, tempBinary, configFile', cacheDir', libsDir) getPathsConfig :: Params cfg a -> IO PathsConfig getPathsConfig params = do (cur, custom, conf, cache, libs) <- getPaths params pure $ PathsConfig cur custom conf libs cache -- | Check if a file exists. If it exists, return Just the modification -- time. If it doesn't exist, return Nothing. maybeModTime :: FilePath -> IO (Maybe UTCTime) maybeModTime path = do fileExists <- doesFileExist path if fileExists then Just <$> getModificationTime path else return Nothing checkFilesModified :: PathsConfig -> IO Bool checkFilesModified paths = do confTime <- maybeModTime (configFile paths) libFiles <- findHaskellFiles (libsDirectory paths) libTimes <- traverse maybeModTime libFiles thisTime <- maybeModTime (runningExecutable paths) tempTime <- maybeModTime (customExecutable paths) pure $ tempTime < confTime -- config newer than custom bin || tempTime < thisTime -- main bin newer than custom bin || any (tempTime <) libTimes -- | Recursively find Haskell files (@.hs@, @.lhs@) at the given -- location. findHaskellFiles :: FilePath -> IO [FilePath] findHaskellFiles d = do exists <- doesDirectoryExist d if exists then do nodes <- getDirectoryContents d let nodes' = map (d ) . filter (`notElem` [".", ".."]) $ nodes files <- filterM isHaskellFile nodes' dirs <- filterM doesDirectoryExist nodes' subfiles <- concat <$> traverse findHaskellFiles dirs pure $ files ++ subfiles else pure [] where isHaskellFile f | any (`isSuffixOf` f) [".hs", ".lhs"] = doesFileExist f | otherwise = pure False dyre-0.9.2/Config/Dyre/Relaunch.hs0000644000000000000000000001116607346545000015070 0ustar0000000000000000{-# 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\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 otherArgs = do masterPath <- fmap (fromMaybe $ error "'dyre' data-store doesn't exist (in Config.Dyre.Relaunch.relaunchMaster)") getMasterBinary customExec masterPath 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 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=' flag. genStatePath :: IO FilePath genStatePath = do pidString <- getPIDString tempDir <- getTemporaryDirectory let statePath = tempDir pidString ++ ".state" putValue "dyre" "persistState" statePath return statePath -- | 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 d Just sp -> do stateData <- readFile sp result <- try $ readIO stateData case result of Left (_ :: SomeException) -> return d Right v -> return 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 d = do statePath <- getStatePersist case statePath of Nothing -> return d Just sp -> do state <- decodeFile sp return $ fromMaybe d state dyre-0.9.2/LICENSE0000644000000000000000000000275307346545000011672 0ustar0000000000000000Copyright (c) 2009, Will Donnelly All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. * Neither the name of the software nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. dyre-0.9.2/Setup.hs0000644000000000000000000000011207346545000012304 0ustar0000000000000000#!/usr/bin/env runhaskell import Distribution.Simple main = defaultMain dyre-0.9.2/Tests/0000755000000000000000000000000007346545000011760 5ustar0000000000000000dyre-0.9.2/Tests/README.mkd0000644000000000000000000000065307346545000013416 0ustar0000000000000000Dyre 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. dyre-0.9.2/Tests/allTests.sh0000755000000000000000000000061607346545000014115 0ustar0000000000000000#!/bin/sh # Run all test scripts for Dyre. if [ -z "$HC" ]; then export HC=ghc fi for TESTDIR in `find . -mindepth 1 -type d`; do echo "Running $TESTDIR" cd $TESTDIR TEST_RESULT=`sh ./runTest.sh 2>&1` TEST_STATUS=$? if [ "$TEST_STATUS" -ne 0 ]; then echo "$TESTDIR failed; output:" echo "$TEST_RESULT"; exit 1 fi cd .. done echo 'Passed' dyre-0.9.2/Tests/basic/0000755000000000000000000000000007346545000013041 5ustar0000000000000000dyre-0.9.2/Tests/basic/Lib.hs0000644000000000000000000000145607346545000014111 0ustar0000000000000000module Lib where import qualified Config.Dyre as Dyre import Config.Dyre.Relaunch import Control.Monad 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 (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" , Dyre.realMain = realMain , Dyre.showError = showError , Dyre.statusOut = const . return $ () } dyre-0.9.2/Tests/basic/Main.hs0000644000000000000000000000005207346545000014256 0ustar0000000000000000import Lib main = basicTest defaultConfig dyre-0.9.2/Tests/basic/MyConfig-updated.hs0000644000000000000000000000011607346545000016532 0ustar0000000000000000module MyConfig where message :: String message = "Modules are still great!" dyre-0.9.2/Tests/basic/MyConfig.hs0000644000000000000000000000011007346545000015100 0ustar0000000000000000module MyConfig where message :: String message = "Modules are great!" dyre-0.9.2/Tests/basic/badConfig.hs0000644000000000000000000000012307346545000015245 0ustar0000000000000000import Lib main = basicTest $ defaultConfig { massage = "Basic Test Version 3.0" } dyre-0.9.2/Tests/basic/goodConfig.hs0000644000000000000000000000012307346545000015447 0ustar0000000000000000import Lib main = basicTest $ defaultConfig { message = "Basic Test Version 2.0" } dyre-0.9.2/Tests/basic/moduleConfig.hs0000644000000000000000000000014507346545000016010 0ustar0000000000000000import Lib import qualified MyConfig main = basicTest $ defaultConfig { message = MyConfig.message } dyre-0.9.2/Tests/basic/runTest.sh0000755000000000000000000000270307346545000015046 0ustar0000000000000000#!/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. . ../subr.sh ### SETUP ### mkdir -p working cd working ### TEST A ### cp ../Lib.hs ../Main.hs . echo "attempting to make" $HC --make Main.hs -o basic || die "compilation failed" 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" ### TEST D ### # Now test that removing the custom config results in # successful run of non-custom binary. rm basicTest.hs OUTPUT_D=`./basic --dyre-debug` assert "$OUTPUT_D" "Basic Test Version 1.0 - 3" "D" ### TEST E ### # Test use of modules under "$confdir/lib/" cp ../moduleConfig.hs basicTest.hs mkdir lib cp ../MyConfig.hs lib/MyConfig.hs OUTPUT_E=`./basic --dyre-debug` assert "$OUTPUT_E" "Modules are great! - 3" "E" ### TEST F ### # Test that changes to modules under "$confdir/lib/" trigger recompilation cp ../moduleConfig.hs basicTest.hs cp ../MyConfig-updated.hs lib/MyConfig.hs OUTPUT_E=`./basic --dyre-debug` assert "$OUTPUT_E" "Modules are still great! - 3" "E" ### TEARDOWN ### echo "Passed" cd .. rm -r working dyre-0.9.2/Tests/config-check/0000755000000000000000000000000007346545000014300 5ustar0000000000000000dyre-0.9.2/Tests/config-check/Lib.hs0000644000000000000000000000102107346545000015334 0ustar0000000000000000module Lib 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 } dyre-0.9.2/Tests/config-check/Main.hs0000644000000000000000000000005107346545000015514 0ustar0000000000000000import Lib main = configCheckMain "main" dyre-0.9.2/Tests/config-check/configCheckTestA.hs0000644000000000000000000000005507346545000020000 0ustar0000000000000000import Lib main = configCheckTest "custom-a" dyre-0.9.2/Tests/config-check/configCheckTestB.hs0000644000000000000000000000005507346545000020001 0ustar0000000000000000import Lib main = configCheckTest "custom-b" dyre-0.9.2/Tests/config-check/runTest.sh0000755000000000000000000000113507346545000016303 0ustar0000000000000000#!/bin/sh # Tests Dyre's ability to recompile a custom configuration # upon relaunch, and restore the state again after. . ../subr.sh mkdir -p working cd working ### TEST A ### cp ../Lib.hs ../Main.hs . cp ../configCheckTestA.hs ./configCheckTest.hs $HC --make Main.hs -o configCheck || die "compilation failed" 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 dyre-0.9.2/Tests/recompile-relaunch/0000755000000000000000000000000007346545000015536 5ustar0000000000000000dyre-0.9.2/Tests/recompile-relaunch/Lib.hs0000644000000000000000000000076707346545000016612 0ustar0000000000000000module Lib 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 $ () } dyre-0.9.2/Tests/recompile-relaunch/Main.hs0000644000000000000000000000006407346545000016756 0ustar0000000000000000import Lib main = recompileRelaunchTest "Testing.." dyre-0.9.2/Tests/recompile-relaunch/recompileRelaunchTest.hs0000644000000000000000000000006707346545000022376 0ustar0000000000000000import Lib main = recompileRelaunchTest "..Successful" dyre-0.9.2/Tests/recompile-relaunch/runTest.sh0000755000000000000000000000106707346545000017545 0ustar0000000000000000#!/bin/sh # Tests Dyre's ability to recompile a custom configuration # upon relaunch, and restore the state again after. . ../subr.sh mkdir -p working cd working ### TEST A ### cp ../Lib.hs ../Main.hs ../recompileRelaunchTest.hs . $HC --make Main.hs -o recompileRelaunch || die "compilation failed" 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 dyre-0.9.2/Tests/subr.sh0000644000000000000000000000036507346545000013273 0ustar0000000000000000# Assert the equality of two strings. assert() { echo "$1" >&2 if [ "$1" != "$2" ]; then echo "Failed test $3"; echo " expected: $2" echo " got: $1" exit 1; fi } die() { echo "$1" ; exit 1 } dyre-0.9.2/Tests/threaded/0000755000000000000000000000000007346545000013540 5ustar0000000000000000dyre-0.9.2/Tests/threaded/Lib.hs0000644000000000000000000000044207346545000014602 0ustar0000000000000000module Lib where import Control.Concurrent (rtsSupportsBoundThreads) import qualified Config.Dyre as Dyre realMain :: String -> IO () realMain s = do putStr s *> putChar ' ' *> print rtsSupportsBoundThreads threadedTest = Dyre.wrapMain $ Dyre.newParams "threadedTest" realMain const dyre-0.9.2/Tests/threaded/Main.hs0000644000000000000000000000006507346545000014761 0ustar0000000000000000import Lib main :: IO () main = threadedTest "main" dyre-0.9.2/Tests/threaded/runTest.sh0000755000000000000000000000064207346545000015545 0ustar0000000000000000#!/bin/sh # If the main executable was compiled with -threaded, Dyre # should also compile the custom executable with -threaded. . ../subr.sh mkdir -p working cd working ### TEST A ### cp ../Lib.hs ../Main.hs ../threadedTest.hs . $HC -threaded --make Main.hs -o threadedTest || die "compilation failed" OUTPUT_A=`./threadedTest --dyre-debug` assert "$OUTPUT_A" "custom True" "A" echo "Passed" cd .. rm -r working dyre-0.9.2/Tests/threaded/threadedTest.hs0000644000000000000000000000006707346545000016517 0ustar0000000000000000import Lib main :: IO () main = threadedTest "custom" dyre-0.9.2/dyre.cabal0000644000000000000000000000430407346545000012606 0ustar0000000000000000name: dyre version: 0.9.2 category: Development, Configuration synopsis: Dynamic reconfiguration in Haskell description: Dyre implements dynamic reconfiguration facilities after the style of Xmonad. Dyre aims to be as simple as possible without sacrificing features, and places an emphasis on simplicity of integration with an application. A full introduction with a complete example project can be found in the documentation for 'Config.Dyre' homepage: http://github.com/willdonnelly/dyre bug-reports: http://github.com/willdonnelly/dyre/issues stability: beta author: Will Donnelly maintainer: Fraser Tweedale copyright: (c) 2011-2023 Will Donnelly, Fraser Tweedale license: BSD3 license-file: LICENSE build-type: Simple cabal-version: >= 1.10 tested-with: GHC ==8.0.2 || ==8.2.2 || ==8.4.4 || ==8.6.5 || ==8.8.4 || ==8.10.7 || ==9.0.2 || ==9.2.7 || ==9.4.5 || ==9.6.1 extra-source-files: CHANGELOG.md Tests/README.mkd Tests/*.sh Tests/basic/*.hs Tests/basic/*.sh Tests/config-check/*.hs Tests/config-check/*.sh Tests/recompile-relaunch/*.hs Tests/recompile-relaunch/*.sh Tests/threaded/*.hs Tests/threaded/*.sh source-repository head type: git location: git://github.com/willdonnelly/dyre.git library default-language: Haskell2010 ghc-options: -Wall exposed-modules: Config.Dyre, Config.Dyre.Paths, Config.Dyre.Compat, Config.Dyre.Params, Config.Dyre.Options, Config.Dyre.Compile, Config.Dyre.Relaunch build-depends: base >= 4.8 && < 5 , binary , directory >= 1.2.0.0 , executable-path , filepath , io-storage , process , time , xdg-basedir if os(windows) build-depends: Win32 else build-depends: unix test-suite tests type: exitcode-stdio-1.0 default-language: Haskell2010 hs-source-dirs: test main-is: Main.hs ghc-options: -Wall build-depends: base , directory >= 1.2.0.0 , process , dyre dyre-0.9.2/test/0000755000000000000000000000000007346545000011635 5ustar0000000000000000dyre-0.9.2/test/Main.hs0000644000000000000000000000025007346545000013052 0ustar0000000000000000import System.Directory (setCurrentDirectory) import System.Process (callCommand) main :: IO () main = do setCurrentDirectory "Tests" callCommand "sh allTests.sh"