darcs-2.14.3: Setup.hs
-- copyright (c) 2008 Duncan Coutts
-- portions copyright (c) 2008 David Roundy
-- portions copyright (c) 2007-2009 Judah Jacobson
{-# OPTIONS_GHC -Wno-deprecations #-}
{-# LANGUAGE CPP #-}
import Distribution.Simple
( defaultMainWithHooks, UserHooks(..), simpleUserHooks )
import Distribution.ModuleName( toFilePath )
import Distribution.PackageDescription
( PackageDescription(executables, testSuites), Executable(exeName)
, emptyBuildInfo
, TestSuite(testBuildInfo)
, updatePackageDescription
, cppOptions, ccOptions
, library, libBuildInfo, otherModules )
import Distribution.Package
( packageVersion )
import Distribution.Version( Version )
import Distribution.Simple.LocalBuildInfo
( LocalBuildInfo(..), absoluteInstallDirs )
import Distribution.Simple.InstallDirs (mandir, CopyDest (NoCopyDest))
import Distribution.Simple.Setup
(buildVerbosity, copyDest, copyVerbosity, fromFlag,
haddockVerbosity, installVerbosity, sDistVerbosity, replVerbosity )
#if MIN_VERSION_Cabal(3,0,0)
import Distribution.Simple.BuildPaths ( autogenPackageModulesDir )
#else
import Distribution.Simple.BuildPaths ( autogenModulesDir )
#endif
import Distribution.System
( OS(Windows), buildOS )
import Distribution.Simple.Utils
(copyFiles, createDirectoryIfMissingVerbose, rawSystemStdout,
#if MIN_VERSION_Cabal(3,0,0)
rewriteFileEx
#else
rewriteFile
#endif
)
import Distribution.Verbosity
( Verbosity, silent )
import Distribution.Text
( display )
import Control.Monad ( unless, void, when )
import System.Directory
( doesDirectoryExist, doesFileExist )
import System.IO
( openFile, IOMode(..) )
import System.Process (runProcess)
import Data.List( isInfixOf, lines )
import System.FilePath ( (</>) )
import Foreign.Marshal.Utils ( with )
import Foreign.Storable ( peek )
import Foreign.Ptr ( castPtr )
import Data.Monoid ( mappend )
import Data.Word ( Word8, Word32 )
import qualified Control.Exception as Exception
#if MIN_VERSION_Cabal(3,0,0)
autogenModulesDir = autogenPackageModulesDir
rewriteFile = rewriteFileEx silent
#endif
catchAny :: IO a -> (Exception.SomeException -> IO a) -> IO a
catchAny f h = Exception.catch f (\e -> h (e :: Exception.SomeException))
main :: IO ()
main = defaultMainWithHooks $ simpleUserHooks {
buildHook = \ pkg lbi hooks flags ->
let verb = fromFlag $ buildVerbosity flags
in commonBuildHook buildHook pkg lbi hooks verb >>= ($ flags),
haddockHook = \ pkg lbi hooks flags ->
let verb = fromFlag $ haddockVerbosity flags
in commonBuildHook haddockHook pkg lbi hooks verb >>= ($ flags) ,
replHook = \pkg lbi hooks flags args ->
let verb = fromFlag $ replVerbosity flags
in commonBuildHook replHook pkg lbi hooks verb >>= (\f -> f flags args) ,
postBuild = \ _ _ _ lbi -> buildManpage lbi,
postCopy = \ _ flags pkg lbi ->
installManpage pkg lbi (fromFlag $ copyVerbosity flags) (fromFlag $ copyDest flags),
postInst = \ _ flags pkg lbi ->
installManpage pkg lbi (fromFlag $ installVerbosity flags) NoCopyDest,
#if !MIN_VERSION_Cabal(3,0,0)
sDistHook = \ pkg lbi hooks flags -> do
let pkgVer = packageVersion pkg
verb = fromFlag $ sDistVerbosity flags
x <- versionPatches verb pkgVer
y <- context verb
rewriteFile "release/distributed-version" $ show x
rewriteFile "release/distributed-context" $ show y
putStrLn "about to hand over"
let pkg' = pkg { library = sanity (library pkg) }
sanity (Just lib) = Just $ lib { libBuildInfo = sanity' $ libBuildInfo lib }
sanity _ = error "eh"
sanity' bi = bi { otherModules = [ m | m <- otherModules bi, toFilePath m /= "Version" ] }
sDistHook simpleUserHooks pkg' lbi hooks flags
,
#endif
postConf = \_ _ _ _ -> return () --- Usually this checked for external C
--- dependencies, but we already have performed such
--- check in the confHook
}
-- | For @./Setup build@ and @./Setup haddock@, do some unusual
-- things, then invoke the base behaviour ("simple hook").
commonBuildHook :: (UserHooks -> PackageDescription -> LocalBuildInfo -> t -> a)
-> PackageDescription -> LocalBuildInfo -> t -> Verbosity -> IO a
commonBuildHook runHook pkg lbi hooks verbosity = do
(version, state) <- determineVersion verbosity pkg
-- Create our own context file.
generateVersionModule verbosity lbi version state
-- Add custom -DFOO[=BAR] flags to the cpp (for .hs) and cc (for .c)
-- invocations, doing a dance to make the base hook aware of them.
littleEndian <- testEndianness
let args = ("-DPACKAGE_VERSION=" ++ show' version) :
[arg | (arg, True) <- -- include fst iff snd.
[-- We have MAPI iff building on/for Windows.
("-DHAVE_MAPI", buildOS == Windows),
("-DLITTLEENDIAN", littleEndian),
("-DBIGENDIAN", not littleEndian)]]
bi = emptyBuildInfo { cppOptions = args, ccOptions = args }
hbi = (Just bi, [(exeName exe, bi) | exe <- executables pkg])
pkg' = updatePackageDescription hbi pkg
-- updatePackageDescription doesn't handle test suites so we
-- need to do this manually
updateTestSuiteBI bi' testSuite
= testSuite { testBuildInfo = bi' `mappend` testBuildInfo testSuite }
pkg'' = pkg' { testSuites = map (updateTestSuiteBI bi) (testSuites pkg') }
lbi' = lbi { localPkgDescr = pkg'' }
return $ runHook simpleUserHooks pkg'' lbi' hooks
where
show' :: String -> String -- Petr was worried that we might
show' = show -- allow non-String arguments.
testEndianness :: IO Bool
testEndianness = with (1 :: Word32) $ \p -> do o <- peek $ castPtr p
return $ o == (1 :: Word8)
-- ---------------------------------------------------------------------
-- man page
-- ---------------------------------------------------------------------
buildManpage :: LocalBuildInfo -> IO ()
buildManpage lbi = do
let darcs = buildDir lbi </> "darcs/darcs"
manpage = buildDir lbi </> "darcs/darcs.1"
darcsExists <- doesFileExist darcs
when darcsExists $ do
manpageHandle <- openFile manpage WriteMode
void $ runProcess darcs ["help","manpage"]
Nothing Nothing Nothing (Just manpageHandle) Nothing
installManpage :: PackageDescription -> LocalBuildInfo
-> Verbosity -> CopyDest -> IO ()
installManpage pkg lbi verbosity copy = do
let manpage = buildDir lbi </> "darcs/darcs.1"
manpageExists <- doesFileExist manpage
when manpageExists $ do
copyFiles verbosity
(mandir (absoluteInstallDirs pkg lbi copy) </> "man1")
[(buildDir lbi </> "darcs", "darcs.1")]
-- ---------------------------------------------------------------------
-- version module
-- ---------------------------------------------------------------------
determineVersion :: Verbosity -> PackageDescription -> IO (String, String)
determineVersion verbosity pkg = do
let darcsVersion = packageVersion pkg
numPatches <- versionPatches verbosity darcsVersion
return (display darcsVersion, versionStateString numPatches)
where
versionStateString :: Maybe Int -> String
versionStateString Nothing = "unknown"
versionStateString (Just 0) = "release"
versionStateString (Just 1) = "+ 1 patch"
versionStateString (Just n) = "+ " ++ show n ++ " patches"
versionPatches :: Verbosity -> Version -> IO (Maybe Int)
versionPatches verbosity darcsVersion = do
numPatchesDarcs <- do
out <- rawSystemStdout verbosity "darcs"
["log", "-a", "--from-tag", display darcsVersion, "--count"]
case reads out of
((n,_):_) -> return $ Just ((n :: Int) - 1)
_ -> return Nothing
`catchAny` \_ -> return Nothing
numPatchesDist <- parseFile versionFile
return $ case (numPatchesDarcs, numPatchesDist) of
(Just x, _) -> Just x
(Nothing, Just x) -> Just x
(Nothing, Nothing) -> Nothing
where
versionFile = "release/distributed-version"
generateVersionModule :: Verbosity -> LocalBuildInfo
-> String -> String -> IO ()
generateVersionModule verbosity lbi version state = do
let dir = autogenModulesDir lbi
createDirectoryIfMissingVerbose verbosity True dir
ctx <- context verbosity
hash <- weakhash verbosity
rewriteFile (dir </> "Version.hs") $ unlines
["module Version where"
,"version, weakhash, context :: String"
,"version = \"" ++ version ++ " (" ++ state ++ ")\""
,"weakhash = " ++ case hash of
Just x -> show x
Nothing -> show "not available"
,"context = " ++ case ctx of
Just x -> show x
Nothing -> show "context not available"
]
weakhash :: Verbosity -> IO (Maybe String)
weakhash verbosity = do
inrepo <- doesDirectoryExist "_darcs"
unless inrepo $ fail "Not a repository."
out <- rawSystemStdout verbosity "darcs" ["show", "repo"]
let line = filter ("Weak Hash:" `isInfixOf`) $ lines out
return $ case (length line) of
0 -> Nothing
_ -> Just $ last $ words $ head line
`catchAny` \_ -> return Nothing
context :: Verbosity -> IO (Maybe String)
context verbosity = do
contextDarcs <- do
inrepo <- doesDirectoryExist "_darcs"
unless inrepo $ fail "Not a repository."
out <- rawSystemStdout verbosity "darcs" ["log", "-a", "--context"]
return $ Just out
`catchAny` \_ -> return Nothing
contextDist <- parseFile contextFile
return $ case (contextDarcs, contextDist) of
(Just x, _) -> Just x
(Nothing, Just x) -> Just x
(Nothing, Nothing) -> Nothing
where contextFile = "release/distributed-context"
parseFile :: (Read a) => String -> IO (Maybe a)
parseFile f = do
exist <- doesFileExist f
if exist then do
content <- readFile f -- ^ ratify readFile: we don't care here.
case reads content of
((s,_):_) -> return s
_ -> return Nothing
else return Nothing