#!/usr/bin/runhugs > module Main where > import Distribution.Simple > import Distribution.PackageDescription (PackageDescription, > readPackageDescription, readHookedBuildInfo) > import Distribution.Simple.LocalBuildInfo (LocalBuildInfo(..)) > import Distribution.Setup(CopyFlags(..), CopyDest(..), ConfigFlags(..)) > import Distribution.Compat.Directory (copyFile) > import Distribution.Compat.FilePath(joinPaths) > import Distribution.Simple.Utils (defaultHookedPackageDesc) > import Distribution.Program(simpleProgram, rawSystemProgramConf) > import System.Directory (removeFile, createDirectoryIfMissing) > import System.Exit(ExitCode(..)) > import Control.Monad(when) > import Data.Maybe(fromJust, isNothing) myPreConf :: Args -> ConfigFlags -> IO HookedBuildInfo > myPreConf (h:_) flags = do > when (h /= "--woohoo") > (error "--woohoo flag (for testing) not passed to ./setup configure.") > copyFile "Setup.buildinfo.in" "Setup.buildinfo" > m <- defaultHookedPackageDesc > when (isNothing m) (error "can't open hooked package description!") > readHookedBuildInfo (configVerbose flags) (fromJust m) > > myPreConf [] _ = error "--woohoo flag (for testing) not passed to ./setup configure." > ppTestHandler :: a -> b -> FilePath -- ^InFile > -> FilePath -- ^OutFile > -> Int -- ^verbose > -> IO ExitCode > ppTestHandler _ _ inFile outFile verbose > = do when (verbose > 0) $ > putStrLn (inFile++" has been preprocessed as a test to "++outFile) > stuff <- readFile inFile > writeFile outFile ("-- this file has been preprocessed as a test\n\n" ++ stuff) > return ExitSuccess > testing :: Args -> Bool -> a -> b -> IO ExitCode > testing [] _ _ _ = return ExitSuccess > testing a@(h:_) _ _ _ = do putStrLn $ "testing: " ++ (show a) > if h == "--pass" > then return ExitSuccess > else return (ExitFailure 1) > myCopyHook :: PackageDescription > -> LocalBuildInfo > -> Maybe UserHooks > -> CopyFlags -- ^install-prefix, verbose > -> IO () > myCopyHook a b c d@(CopyFlags (CopyPrefix p) _) = do > -- call 'ls' from our hookedPrograms hook... pointless except as a demo > rawSystemProgramConf 0 "ls" (withPrograms b) [] > let copySource = case compilerFlavor $ compiler b of > GHC -> foldl1 joinPaths ["dist", "build", "withHooks", "withHooks"] > Hugs -> foldl1 joinPaths ["dist", "build", "Main.hs"] -- some random file > createDirectoryIfMissing True p > copyFile copySource (p `joinPaths` "withHooks") > -- now call the default copy hook so the rest of the test case works nice ... so tricky ;) > (copyHook defaultUserHooks) a b c d > myCopyHook _ _ _ _ = error "Please use --copy-prefix." Override "gc" to test the overriding mechanism. > main :: IO () > main = defaultMainWithHooks defaultUserHooks > {preConf=myPreConf, > hookedPrograms=[simpleProgram "ls"], > runTests=testing, > postConf=(\_ _ _ _ -> return ExitSuccess), > hookedPreProcessors= [("testSuffix", ppTestHandler), ("gc", ppTestHandler)], > postClean=(\_ _ _ _ -> removeFile "Setup.buildinfo" >> return ExitSuccess), > copyHook=myCopyHook > }