Plan 9 from Bell Labs’s /usr/web/sources/contrib/fernan/nhc98/src/libraries/Cabal/tests/withHooks/Setup.lhs

Copyright © 2021 Plan 9 Foundation.
Distributed under the MIT License.
Download the Plan 9 distribution.


#!/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
>        }

Bell Labs OSI certified Powered by Plan 9

(Return to Plan 9 Home Page)

Copyright © 2021 Plan 9 Foundation. All Rights Reserved.
Comments to [email protected].