main = defaultMain
or
main = defaultMainWithHooks, with an unmodified standard set of hooks.
Currently, a minority of Setup files serve as non-trivial
examples, as reflected in the numbers below. I'm separating the
listing of Setup files into two sections, those with substantial
customization of user hooks and those with a potentially less
interesting test-only customization. (Just the
runTests user hook is customized.) This separation
is not exact, but should generally aid in browsing these
examples.
Total Cabal packages: 1731
Cabal packages With custom Setup files: 124
Selected ratio: 7.2%
Reference module: Distribution.Simple
This report was generated with cbs-find.el on Sunday, December 13, 2009
#!/usr/bin/runhaskell
\begin{code}
module Main where
import Distribution.PackageDescription (PackageDescription(..))
import Distribution.Simple.Setup ( BuildFlags(..), buildVerbose )
import Distribution.Simple ( defaultMainWithHooks, defaultUserHooks, UserHooks(..) )
import Distribution.Simple.LocalBuildInfo ( LocalBuildInfo(..) )
import Distribution.Simple.Program
import System.FilePath (())
import System.IO.Error ( try )
import System.Directory (removeFile)
main :: IO ()
main = defaultMainWithHooks defaultUserHooks{ hookedPrograms = [perlProgram],
postBuild = myPostBuild,
postClean = myPostClean,
copyHook = myCopy,
instHook = myInstall }
perlProgram = simpleProgram "perl"
-- hack to turn cpp-style '# 27 "GenericTemplate.hs"' into
-- '{-# LINE 27 "GenericTemplate.hs" #-}'.
crazy_perl_regexp =
"s/^#\\s+(\\d+)\\s+(\"[^\"]*\")/{-# LINE \\1 \\2 #-}/g;s/\\$(Id:.*)\\$/\\1/g"
myPostBuild _ flags _ lbi = do
let runProgram p = rawSystemProgramConf (buildVerbose flags) p (withPrograms lbi)
cpp_template src dst opts = do
runProgram ghcProgram (["-o", dst, "-E", "-cpp", "templates" src] ++ opts)
runProgram perlProgram ["-i.bak", "-pe", crazy_perl_regexp, dst]
sequence_ ([ cpp_template "GenericTemplate.hs" dst opts | (dst,opts) <- templates ] ++
[ cpp_template "wrappers.hs" dst opts | (dst,opts) <- wrappers ])
myPostClean _ _ _ _ = mapM_ (try . removeFile) all_template_files
myInstall pkg_descr lbi hooks flags =
instHook defaultUserHooks pkg_descr' lbi hooks flags
where pkg_descr' = pkg_descr {
dataFiles = dataFiles pkg_descr ++ all_template_files
}
myCopy pkg_descr lbi hooks copy_flags =
copyHook defaultUserHooks pkg_descr' lbi hooks copy_flags
where pkg_descr' = pkg_descr {
dataFiles = dataFiles pkg_descr ++ all_template_files
}
all_template_files :: [FilePath]
all_template_files = map fst (templates ++ wrappers)
templates :: [(FilePath,[String])]
templates = [
("AlexTemplate", []),
("AlexTemplate-ghc", ["-DALEX_GHC"]),
("AlexTemplate-ghc-debug", ["-DALEX_GHC","-DALEX_DEBUG"]),
("AlexTemplate-debug", ["-DALEX_DEBUG"])
]
wrappers :: [(FilePath,[String])]
wrappers = [
("AlexWrapper-basic", ["-DALEX_BASIC"]),
("AlexWrapper-basic-bytestring", ["-DALEX_BASIC_BYTESTRING"]),
("AlexWrapper-strict-bytestring", ["-DALEX_STRICT_BYTESTRING"]),
("AlexWrapper-posn", ["-DALEX_POSN"]),
("AlexWrapper-posn-bytestring", ["-DALEX_POSN_BYTESTRING"]),
("AlexWrapper-monad", ["-DALEX_MONAD"]),
("AlexWrapper-monad-bytestring", ["-DALEX_MONAD_BYTESTRING"]),
("AlexWrapper-monadUserState", ["-DALEX_MONAD", "-DALEX_MONAD_USER_STATE"]),
("AlexWrapper-monadUserState-bytestring", ["-DALEX_MONAD_BYTESTRING", "-DALEX_MONAD_USER_STATE"]),
("AlexWrapper-gscan", ["-DALEX_GSCAN"])
]
\end{code}
#!/usr/bin/runhaskell
import Distribution.Simple
import Distribution.Simple.Setup (ConfigFlags (..))
import Distribution.PackageDescription (emptyHookedBuildInfo,HookedBuildInfo(..))
import Language.Haskell.HsColour (hscolour,Output(CSS))
import Language.Haskell.HsColour.Colourise (defaultColourPrefs)
import Control.Monad
import Data.Maybe
import Data.List
main :: IO ()
main = defaultMainWithHooks hooks
hooks :: UserHooks
hooks = simpleUserHooks { preConf = myPreConf }
myPreConf :: Args -> ConfigFlags -> IO HookedBuildInfo
myPreConf args cf = do
makedocs
return emptyHookedBuildInfo
-- read template file with markers, call replaceOrEcho for each marker
makedocs :: IO ()
makedocs = do
putStr "Generating custom html documentation... "
file <- readFile "data/astview-tmpl.html"
replaced <- mapM replaceOrEcho (lines file)
putStrLn " done."
writeFile "data/astview.html" (unlines . concat $ replaced)
return ()
-- echoes the current line, or, if mymatch succeeds:
-- replaces the line with colourized haskell code.
replaceOrEcho :: String -> IO [String]
replaceOrEcho s = if not $ match s
then return [s]
else do
putStr $ (extract s)++" "
file <- readFile ("data/"++(extract s)++".hs.txt")
let replacement = lines $ hscolour CSS defaultColourPrefs False True (extract s) False file
return ([""]
++ replacement
++ [""])
-- interface that delegates to various implementations:
-- recognizes Template marker of the form "%%asdf%%"
match :: String -> Bool
match = match0 "%%"
--extracts the filename from the marker
extract :: String -> String
extract = extract1 "%%"
-------- Implementations --------------
match0 :: String -> String -> Bool
match0 p s = take 2 s == p && take 2 (reverse s) == p
match1 :: String -> String -> Bool
match1 p = liftM2 (&&)
(help p)
(help p . reverse)
where help q = (q ==) . (take (length q))
match2 :: String -> String -> Bool
match2 p s = p `isSuffixOf` s && (reverse p) `isPrefixOf` s
extract1 :: String -> String -> String
extract1 p s = let remainder = (drop (length p) s) in reverse (drop (length p) (reverse remainder) )
extract2 :: String -> String -> String
extract2 p s = reverse (drop (length p) (reverse (drop (length p) s)))
extract3 :: String -> String -> String
extract3 p s = reverse . drop (length p) $ reverse $ drop (length p) s
extract4 :: String -> String
extract4 = help . reverse . help
where help :: String -> String
help = fromJust . (stripPrefix "%%%")
#!/usr/bin/env runhaskell
-- file: Setup.hs
-- Haskell bindings for the Augeas library
-- Copyright (c) 2009, Jude Nagurney
--
-- This program is free software; you can redistribute it and/or modify it
-- under the terms of the GNU General Public License as published by the Free
-- Software Foundation; either version 2 of the License, or (at your option)
-- any later version.
--
-- This program is distributed in the hope that it will be useful, but
-- WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
-- FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details.
--
-- You should have received a copy of the GNU General Public License along with this program;
-- if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston,
-- MA 02111-1307 USA
--
-- Contact the author at
-- jude@pwan.org
import Data.List (isInfixOf)
import Distribution.PackageDescription
import Distribution.Simple
import System.Process
-- main = defaultMain
-- Thanks http://mechablue.livejournal.com/11055.html
main = defaultMainWithHooks simpleUserHooks { runTests = _runTests, instHook = _instHook }
where
-- Run all executables with names that end in -tests
_runTests _ _ pd _ = do
let exeNames = ["dist/build/" ++ fp ++ "/" ++ fp | fp <- map exeName (executables pd)]
sequence [_runTest e | e <- exeNames, isInfixOf "test-" e]
return ()
_runTest fp = do
ph <- runCommand fp
waitForProcess ph
-- Only install executables that don't end in -tests
_instHook pd lbi uhs ifs = do
let execs = filter (\e -> not $ isInfixOf "test-" (exeName e)) (executables pd)
(instHook simpleUserHooks) (pd {executables = execs}) lbi uhs ifs
--tests _ _ _ _ = do
---- setCurrentDirectory "src"
-- h <- runCommand "/usr/bin/env runghc -laugeas HUnitAug"
-- waitForProcess h
-- return ()
#!/usr/bin/env runhaskell
module Main (main) where { import Distribution.Simple ; main =
defaultMain }
import Distribution.Simple
import Distribution.Simple.LocalBuildInfo (LocalBuildInfo(withPrograms), buildDir)
import Distribution.Simple.Program (userSpecifyArgs)
import System.Directory
import System.FilePath
-- Define __HADDOCK__ when building documentation.
main = defaultMainWithHooks simpleUserHooks {
haddockHook = \pkg lbi h f -> do
let progs = userSpecifyArgs "hsc2hs" ["-D__HADDOCK__"] (withPrograms lbi)
removePreProcessedFiles (buildDir lbi)
haddockHook simpleUserHooks pkg lbi { withPrograms = progs } h f
}
-- Horrible hack to force re-processing of the .hsc file. Otherwise
-- the __HADDOCK__ macro doesn't end up being defined.
removePreProcessedFiles :: FilePath -> IO ()
removePreProcessedFiles dir = do
putStrLn $ "Trying to remove source in: " ++ dir
removeFile (dir "System/BSD/Sysctl.hs")
`catch` \_ -> putStrLn "Could not find source file!" >> return ()
#!/usr/bin/env runhaskell
import Distribution.Simple
import Distribution.PackageDescription
import Distribution.Simple.LocalBuildInfo
import Distribution.Version
import System.Info
import Data.Maybe
import System.Cmd
missingHooks = defaultUserHooks {confHook = customConfHook}
customConfHook descrip flags =
let mydescrip = case System.Info.os of
"mingw32" -> descrip
_ -> descrip {buildDepends =
(Dependency "unix" AnyVersion) :
buildDepends descrip}
in (confHook defaultUserHooks) mydescrip flags
main = defaultMainWithHooks missingHooks
#!/usr/bin/env runhaskell
> import Distribution.Simple
> import System.Process (rawSystem)
> import System.Exit (ExitCode(..))
> main = defaultMainWithHooks $ simpleUserHooks { runTests = \args _ _ _ -> do
> ExitSuccess <- rawSystem "runhaskell" ("Test.hs" : args)
> return ()
> }
#!/usr/bin/env runhaskell
import Data.Char.CEDICT.GenerateCode
import System.IO.UTF8
import System.IO hiding
( appendFile
, getContents
, getLine
, print
, putStr
, putStrLn
, readFile
, readLn
, writeFile
, hGetContents
, hGetLine
, hPutStr
, hPutStrLn
)
import Prelude hiding
( appendFile
, getContents
, getLine
, print
, putStr
, putStrLn
, readFile
, readLn
, writeFile
)
import Distribution.Simple
import Distribution.PackageDescription
import Control.Monad
import System.FilePath
import System.Directory
import System.Time
import System.Locale
hooks = defaultUserHooks { preBuild = optionalGenC }
main = defaultMainWithHooks hooks
optionalGenC _ _ = do
n <- needed
when n genC
return emptyHookedBuildInfo
where
headerPath = combine "c" "data.h"
dictPath = combine "d" "utf8-cedict"
needed = do
f' <- doesFileExist headerPath
f'' <- if f' then tCompare else return True
when (not f'') $ putStrLn $ "Found existing header file at " ++ headerPath
return f''
genC = do
hPutStrLn stderr "Generating CEDICT header file -- may take a few minutes."
t <- bench $ readAndWrite dictPath headerPath
hPutStrLn stderr $ " " ++ show t ++ " seconds"
tCompare = do
headerTime <- getModificationTime headerPath
dictTime <- getModificationTime dictPath
return $ headerTime < dictTime
bench op = do
ts <- getClockTime
op
tf <- getClockTime
return $ tdSec $ diffClockTimes tf ts
import Distribution.Simple
( defaultMainWithHooks, UserHooks(..), simpleUserHooks )
import Distribution.Simple.LocalBuildInfo( LocalBuildInfo(..) )
import System( system, exitWith )
import System.FilePath( () )
main :: IO ()
main = defaultMainWithHooks simpleUserHooks {
runTests = \ _ _ _ lbi -> do
exitWith =<< system (buildDir lbi "darcs-benchmark" "darcs-benchmark")
}
\begin{code}
{-# OPTIONS_GHC -cpp #-}
-- copyright (c) 2008 Duncan Coutts
-- portions copyright (c) 2008 David Roundy
import Distribution.Simple
( defaultMainWithHooks, UserHooks(..), simpleUserHooks )
import Distribution.PackageDescription
( PackageDescription(executables), Executable(buildInfo, exeName)
, BuildInfo(customFieldsBI), emptyBuildInfo
, updatePackageDescription, cppOptions, ccOptions )
import Distribution.Package
( packageVersion )
import Distribution.Version
( Version(versionBranch) )
import Distribution.Simple.LocalBuildInfo
( LocalBuildInfo(..), absoluteInstallDirs )
import Distribution.Simple.InstallDirs (mandir, CopyDest (NoCopyDest))
import Distribution.Simple.Setup
(buildVerbosity, copyDest, copyVerbosity, fromFlag,
haddockVerbosity, installVerbosity, sDistVerbosity)
import Distribution.Simple.BuildPaths
( autogenModulesDir )
import Distribution.System
( OS(Windows), buildOS )
import Distribution.Simple.Utils
(copyFiles, createDirectoryIfMissingVerbose, rawSystemStdout,
rewriteFile)
import Distribution.Verbosity
( Verbosity )
import Distribution.Text
( display )
import Distribution.Package (Package)
import Control.Monad ( zipWithM_, when, unless, filterM )
import Control.Exception ( bracket )
import System.Directory
(copyFile, createDirectory, createDirectoryIfMissing,
doesDirectoryExist, doesFileExist,
getCurrentDirectory, getDirectoryContents,
removeDirectoryRecursive, removeFile, setCurrentDirectory)
import System.IO (openFile, IOMode (..))
import System.Process (runProcess)
import System.IO.Error ( isDoesNotExistError )
import Data.List( isSuffixOf, sort, partition )
import System.FilePath ( (), splitDirectories, isAbsolute )
import Foreign.Marshal.Utils ( with )
import Foreign.Storable ( peek )
import Foreign.Ptr ( castPtr )
import Data.Word ( Word8, Word32 )
import qualified Distribution.ShellHarness as Harness ( runTests )
#if __GLASGOW_HASKELL__ >= 610
import qualified Control.OldException as Exception
#else
import qualified Control.Exception as Exception
#endif
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) ,
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,
runTests = \ args _ _ lbi -> do
cwd <- getCurrentDirectory
let isabs = isAbsolute $ buildDir lbi
path = (if isabs then id else (cwd ))
(buildDir lbi "darcs")
what = if null args then ["tests"] else args
(series, tests) = partition
(`elem` ["bugs", "network", "tests"]) what
sequence_ [ case w of
"bugs" -> allTests path Bug []
"network" -> execTests path Network "" []
"tests" -> allTests path Test []
_ -> return () {- impossible, silence -Wall -}
| w <- series ]
when (not $ null tests) $ individualTests path tests,
-- Remove the temporary directories created by "cabal test".
postClean = \ _ _ _ _ -> mapM_ rmRf
["tests-darcs-2.dir",
"tests-hashed.dir",
"tests-old-fashioned-inventory.dir",
"bugs-darcs-2.dir",
"bugs-hashed.dir",
"bugs-old-fashioned-inventory.dir",
"tests_network-.dir"],
sDistHook = \ pkg lbi hooks flags -> do
let pkgVer = packageVersion pkg
verb = fromFlag $ sDistVerbosity flags
x <- versionPatches verb pkgVer
y <- context verb pkgVer
rewriteFile "release/distributed-version" $ show x
rewriteFile "release/distributed-context" $ show y
sDistHook simpleUserHooks pkg lbi hooks flags
}
-- | 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
-- Autoconf may have generated a context file. Remove it before
-- building, as its existence inexplicably breaks Cabal.
removeFile "src/Context.hs"
`catch` (\e -> unless (isDoesNotExistError e) (ioError e))
-- Create our own context file.
writeGeneratedModules verbosity pkg lbi
-- 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.
(version, state) <- determineVersion verbosity pkg
littleEndian <- testEndianness
let args = ("-DPACKAGE_VERSION=" ++ show' version) :
("-DPACKAGE_VERSION_STATE=" ++ show' state) :
[arg | (arg, True) <- -- include fst iff snd.
[("-DHAVE_HTTP", "x-have-http" `elem` customFields),
("-DUSE_COLOR", "x-use-color" `elem` customFields),
-- We have MAPI iff building on/for Windows.
("-DHAVE_MAPI", buildOS == Windows),
("-DBIGENDIAN", not littleEndian)]]
bi = emptyBuildInfo { cppOptions = args, ccOptions = args }
hbi = (Just bi, [(exeName exe, bi) | exe <- executables pkg])
pkg' = updatePackageDescription hbi pkg
lbi' = lbi { localPkgDescr = pkg' }
return $ runHook simpleUserHooks pkg' lbi' hooks
where
customFields = map fst . customFieldsBI . buildInfo $ darcsExe
darcsExe = head [e | e <- executables pkg, exeName e == "darcs"]
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)
buildManpage :: LocalBuildInfo -> IO ()
buildManpage lbi = do
let darcs = buildDir lbi "darcs/darcs"
manpage = buildDir lbi "darcs/darcs.1"
manpageHandle <- openFile manpage WriteMode
runProcess darcs ["help","manpage"]
Nothing Nothing Nothing (Just manpageHandle) Nothing
return ()
installManpage :: PackageDescription -> LocalBuildInfo
-> Verbosity -> CopyDest -> IO ()
installManpage pkg lbi verbosity copy =
copyFiles verbosity
(mandir (absoluteInstallDirs pkg lbi copy) "man1")
[(buildDir lbi "darcs", "darcs.1")]
writeGeneratedModules :: Verbosity
-> PackageDescription -> LocalBuildInfo -> IO ()
writeGeneratedModules verbosity pkg lbi = do
createDirectoryIfMissingVerbose verbosity True (autogenModulesDir lbi)
let contextModulePath = autogenModulesDir lbi "Context.hs"
generateContextModule verbosity contextModulePath pkg
determineVersion :: Verbosity -> PackageDescription -> IO (String, String)
determineVersion verbosity pkg = do
let darcsVersion = packageVersion pkg
numPatches <- versionPatches verbosity darcsVersion
return (display darcsVersion, versionStateString numPatches darcsVersion)
where
versionStateString :: Maybe Int -> Version -> String
versionStateString Nothing _ = "unknown"
versionStateString (Just 0) v = case versionBranch v of
x | 97 `elem` x -> "alpha " ++ show (after 97 x)
| 98 `elem` x -> "beta " ++ show (after 98 x)
| 99 `elem` x ->
"release candidate " ++ show (after 99 x)
_ -> "release"
versionStateString (Just 1) _ = "+ 1 patch"
versionStateString (Just n) _ = "+ " ++ show n ++ " patches"
after w (x:r) | w == x = head r
| otherwise = after w r
after _ [] = undefined
versionPatches :: Verbosity -> Version -> IO (Maybe Int)
versionPatches verbosity darcsVersion = do
numPatchesDarcs <- do
out <- rawSystemStdout verbosity "darcs"
["changes", "--from-tag", display darcsVersion, "--count"]
case reads (out) of
((n,_):_) -> return $ Just ((n :: Int) - 1)
_ -> return Nothing
`Exception.catch` \_ -> 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"
generateContextModule :: (Package pkg) => Verbosity -> FilePath -> pkg -> IO ()
generateContextModule verbosity targetFile pkg = do
ctx <- context verbosity (packageVersion pkg)
rewriteFile targetFile $ unlines
["module Context where"
,"context :: String"
,"context = " ++ case ctx of
Just x -> show x
Nothing -> show "context not available"
]
context :: Verbosity -> Version -> IO (Maybe String)
context verbosity version = do
contextDarcs <- do
-- FIXME currently we run changes --from-tag to at least assert that the
-- requested version is tagged in this repository... it is a weak check,
-- but otherwise, my ~/_darcs context tends to gets used when running
-- from an unpacked distribution
rawSystemStdout verbosity "darcs"
["changes", "--from-tag", display version ]
out <- rawSystemStdout verbosity "darcs" ["changes", "--context"]
return $ Just out
`Exception.catch` \_ -> 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
-------------------------------------
-- Running the testsuite
--
data TestKind = Bug | Test | Network deriving Eq
instance Show TestKind where
show Bug = "bugs"
show Test = "tests"
show Network = "tests/network"
flat :: (Show a) => a -> String
flat a = [ if x == '/' then '_' else x | x <- show a ]
isTest :: FilePath -> Bool
isTest = (".sh" `isSuffixOf`)
execTests :: FilePath -> TestKind -> String -> [String] -> IO ()
execTests darcs_path k fmt tests = do
let dir = (flat k) ++ "-" ++ fmt ++ ".dir"
rmRf dir
cloneTree (show k) dir
withCurrentDirectory dir $ do
createDirectory ".darcs"
when (not $ null fmt) $ appendFile ".darcs/defaults" $ "ALL " ++ fmt ++ "\n"
putStrLn $ "Running tests for format: " ++ fmt
exec
where exec = do
fs <- case tests of
[] -> sort `fmap` getDirectoryContents "."
x -> return x
cwd <- getCurrentDirectory
let run = filter isTest fs
res <- Harness.runTests (Just darcs_path) cwd run
when ((not res) && (k /= Bug)) $ fail "Tests failed"
return ()
individualTests :: FilePath -> [String] -> IO ()
individualTests darcs_path tests = do
run <- concat `fmap` mapM find tests
sequence_ [ do exec kind [test | (kind', test) <- run, kind' == kind]
| kind <- [Test, Bug, Network] ]
where tryin w t' = [w t', w (t' ++ ".sh")]
exec _ [] = return ()
exec kind to_run = allTests darcs_path kind to_run
find t = do
let c = [t, t ++ ".sh"] ++ tryin "tests" t ++ tryin "bugs" t
++ tryin "network" t
run <- map kindify `fmap` filterM doesFileExist c
return $ take 1 run
kindify test = case splitDirectories test of
[p, y] -> (parse_kind p, y)
_ -> error $ "Bad format in " ++ test ++
": expected type/test"
parse_kind "tests" = Test
parse_kind "bugs" = Bug
parse_kind "network" = Network
parse_kind x = error $ "Test prefix must be one of " ++
"[tests, bugs, network] in " ++ x
allTests :: FilePath -> TestKind -> [String] -> IO ()
allTests darcs_path k s =
do test `mapM` repotypes
return ()
where repotypes = ["darcs-2", "hashed", "old-fashioned-inventory"]
test x = execTests darcs_path k x s
-------------------------------------------------------
-- Utility functions (FIXME)
-- copy & paste & edit: darcs wants to share these
--
withCurrentDirectory :: FilePath -> IO a -> IO a
withCurrentDirectory name m =
bracket
(do cwd <- getCurrentDirectory
when (name /= "") (setCurrentDirectory name)
return cwd)
(\oldwd -> setCurrentDirectory oldwd `catch` (\_ -> return ()))
(const m)
cloneTree :: FilePath -> FilePath -> IO ()
cloneTree = cloneTreeExcept []
cloneTreeExcept :: [FilePath] -> FilePath -> FilePath -> IO ()
cloneTreeExcept except source dest =
do isdir <- doesDirectoryExist source
if isdir then do
createDirectoryIfMissing True dest
fps <- getDirectoryContents source
let fps' = filter (`notElem` (".":"..":except)) fps
mk_source fp = source ++ "/" ++ fp
mk_dest fp = dest ++ "/" ++ fp
zipWithM_ cloneSubTree (map mk_source fps') (map mk_dest fps')
else fail ("cloneTreeExcept: Bad source " ++ source)
`catch` fail ("cloneTreeExcept: Bad source " ++ source)
cloneSubTree :: FilePath -> FilePath -> IO ()
cloneSubTree source dest =
do isdir <- doesDirectoryExist source
isfile <- doesFileExist source
if isdir then do
createDirectory dest
fps <- getDirectoryContents source
let fps' = filter (`notElem` [".", ".."]) fps
mk_source fp = source ++ "/" ++ fp
mk_dest fp = dest ++ "/" ++ fp
zipWithM_ cloneSubTree (map mk_source fps') (map mk_dest fps')
else if isfile then do
cloneFile source dest
else fail ("cloneSubTree: Bad source "++ source)
`catch` (\e -> if isDoesNotExistError e
then return ()
else ioError e)
cloneFile :: FilePath -> FilePath -> IO ()
cloneFile = copyFile
rmRf :: FilePath -> IO ()
rmRf path = do
isdir <- doesDirectoryExist path
isf <- doesFileExist path
when isdir $ removeDirectoryRecursive path
when isf $ removeFile path
return ()
-- (END FIXME)
\end{code}
\begin{code}
{-# OPTIONS_GHC -cpp #-}
-- copyright (c) 2008 Duncan Coutts
-- portions copyright (c) 2008 David Roundy
import Distribution.Simple
( defaultMainWithHooks, UserHooks(..), simpleUserHooks )
import Distribution.PackageDescription
( PackageDescription(executables), Executable(buildInfo, exeName)
, BuildInfo(customFieldsBI), emptyBuildInfo
, updatePackageDescription, cppOptions, ccOptions )
import Distribution.Package
( packageVersion )
import Distribution.Version
( Version(versionBranch) )
import Distribution.Simple.LocalBuildInfo
( LocalBuildInfo(..), absoluteInstallDirs )
import Distribution.Simple.InstallDirs (mandir, CopyDest (NoCopyDest))
import Distribution.Simple.Setup
(buildVerbosity, copyDest, copyVerbosity, fromFlag,
haddockVerbosity, installVerbosity, sDistVerbosity)
import Distribution.Simple.BuildPaths
( autogenModulesDir )
import Distribution.System
( OS(Windows), buildOS )
import Distribution.Simple.Utils
(copyFiles, createDirectoryIfMissingVerbose, rawSystemStdout,
rewriteFile)
import Distribution.Verbosity
( Verbosity )
import Distribution.Text
( display )
import Distribution.Package (Package)
import Control.Monad ( zipWithM_, when, unless, filterM )
import Control.Exception ( bracket )
import System.Directory
(copyFile, createDirectory, createDirectoryIfMissing,
doesDirectoryExist, doesFileExist,
getCurrentDirectory, getDirectoryContents,
removeDirectoryRecursive, removeFile, setCurrentDirectory)
import System.IO (openFile, IOMode (..))
import System.Process (runProcess)
import System.IO.Error ( isDoesNotExistError )
import Data.List( isSuffixOf, sort, partition )
import System.FilePath ( (), splitDirectories, isAbsolute )
import Foreign.Marshal.Utils ( with )
import Foreign.Storable ( peek )
import Foreign.Ptr ( castPtr )
import Data.Word ( Word8, Word32 )
import qualified Distribution.ShellHarness as Harness ( runTests )
#if __GLASGOW_HASKELL__ >= 610
import qualified Control.OldException as Exception
#else
import qualified Control.Exception as Exception
#endif
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) ,
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,
runTests = \ args _ _ lbi -> do
cwd <- getCurrentDirectory
let isabs = isAbsolute $ buildDir lbi
path = (if isabs then id else (cwd ))
(buildDir lbi "darcs")
what = if null args then ["tests"] else args
(series, tests) = partition
(`elem` ["bugs", "network", "tests"]) what
sequence_ [ case w of
"bugs" -> allTests path Bug []
"network" -> execTests path Network "" []
"tests" -> allTests path Test []
_ -> return () {- impossible, silence -Wall -}
| w <- series ]
when (not $ null tests) $ individualTests path tests,
-- Remove the temporary directories created by "cabal test".
postClean = \ _ _ _ _ -> mapM_ rmRf
["tests-darcs-2.dir",
"tests-hashed.dir",
"tests-old-fashioned-inventory.dir",
"bugs-darcs-2.dir",
"bugs-hashed.dir",
"bugs-old-fashioned-inventory.dir",
"tests_network-.dir"],
sDistHook = \ pkg lbi hooks flags -> do
let pkgVer = packageVersion pkg
verb = fromFlag $ sDistVerbosity flags
x <- versionPatches verb pkgVer
y <- context verb pkgVer
rewriteFile "release/distributed-version" $ show x
rewriteFile "release/distributed-context" $ show y
sDistHook simpleUserHooks pkg lbi hooks flags
}
-- | 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
-- Autoconf may have generated a context file. Remove it before
-- building, as its existence inexplicably breaks Cabal.
removeFile "src/Context.hs"
`catch` (\e -> unless (isDoesNotExistError e) (ioError e))
-- Create our own context file.
writeGeneratedModules verbosity pkg lbi
-- 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.
(version, state) <- determineVersion verbosity pkg
littleEndian <- testEndianness
let args = ("-DPACKAGE_VERSION=" ++ show' version) :
("-DPACKAGE_VERSION_STATE=" ++ show' state) :
[arg | (arg, True) <- -- include fst iff snd.
[("-DHAVE_HTTP", "x-have-http" `elem` customFields),
("-DUSE_COLOR", "x-use-color" `elem` customFields),
-- We have MAPI iff building on/for Windows.
("-DHAVE_MAPI", buildOS == Windows),
("-DBIGENDIAN", not littleEndian)]]
bi = emptyBuildInfo { cppOptions = args, ccOptions = args }
hbi = (Just bi, [(exeName exe, bi) | exe <- executables pkg])
pkg' = updatePackageDescription hbi pkg
lbi' = lbi { localPkgDescr = pkg' }
return $ runHook simpleUserHooks pkg' lbi' hooks
where
customFields = map fst . customFieldsBI . buildInfo $ darcsExe
darcsExe = head [e | e <- executables pkg, exeName e == "darcs"]
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)
buildManpage :: LocalBuildInfo -> IO ()
buildManpage lbi = do
let darcs = buildDir lbi "darcs/darcs"
manpage = buildDir lbi "darcs/darcs.1"
manpageHandle <- openFile manpage WriteMode
runProcess darcs ["help","manpage"]
Nothing Nothing Nothing (Just manpageHandle) Nothing
return ()
installManpage :: PackageDescription -> LocalBuildInfo
-> Verbosity -> CopyDest -> IO ()
installManpage pkg lbi verbosity copy =
copyFiles verbosity
(mandir (absoluteInstallDirs pkg lbi copy) "man1")
[(buildDir lbi "darcs", "darcs.1")]
writeGeneratedModules :: Verbosity
-> PackageDescription -> LocalBuildInfo -> IO ()
writeGeneratedModules verbosity pkg lbi = do
createDirectoryIfMissingVerbose verbosity True (autogenModulesDir lbi)
let contextModulePath = autogenModulesDir lbi "Context.hs"
generateContextModule verbosity contextModulePath pkg
determineVersion :: Verbosity -> PackageDescription -> IO (String, String)
determineVersion verbosity pkg = do
let darcsVersion = packageVersion pkg
numPatches <- versionPatches verbosity darcsVersion
return (display darcsVersion, versionStateString numPatches darcsVersion)
where
versionStateString :: Maybe Int -> Version -> String
versionStateString Nothing _ = "unknown"
versionStateString (Just 0) v = case versionBranch v of
x | 97 `elem` x -> "alpha " ++ show (after 97 x)
| 98 `elem` x -> "beta " ++ show (after 98 x)
| 99 `elem` x ->
"release candidate " ++ show (after 99 x)
_ -> "release"
versionStateString (Just 1) _ = "+ 1 patch"
versionStateString (Just n) _ = "+ " ++ show n ++ " patches"
after w (x:r) | w == x = head r
| otherwise = after w r
after _ [] = undefined
versionPatches :: Verbosity -> Version -> IO (Maybe Int)
versionPatches verbosity darcsVersion = do
numPatchesDarcs <- do
out <- rawSystemStdout verbosity "darcs"
["changes", "--from-tag", display darcsVersion, "--count"]
case reads (out) of
((n,_):_) -> return $ Just ((n :: Int) - 1)
_ -> return Nothing
`Exception.catch` \_ -> 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"
generateContextModule :: (Package pkg) => Verbosity -> FilePath -> pkg -> IO ()
generateContextModule verbosity targetFile pkg = do
ctx <- context verbosity (packageVersion pkg)
rewriteFile targetFile $ unlines
["module Context where"
,"context :: String"
,"context = " ++ case ctx of
Just x -> show x
Nothing -> show "context not available"
]
context :: Verbosity -> Version -> IO (Maybe String)
context verbosity version = do
contextDarcs <- do
-- FIXME currently we run changes --from-tag to at least assert that the
-- requested version is tagged in this repository... it is a weak check,
-- but otherwise, my ~/_darcs context tends to gets used when running
-- from an unpacked distribution
rawSystemStdout verbosity "darcs"
["changes", "--from-tag", display version ]
out <- rawSystemStdout verbosity "darcs" ["changes", "--context"]
return $ Just out
`Exception.catch` \_ -> 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
-------------------------------------
-- Running the testsuite
--
data TestKind = Bug | Test | Network deriving Eq
instance Show TestKind where
show Bug = "bugs"
show Test = "tests"
show Network = "tests/network"
flat :: (Show a) => a -> String
flat a = [ if x == '/' then '_' else x | x <- show a ]
isTest :: FilePath -> Bool
isTest = (".sh" `isSuffixOf`)
execTests :: FilePath -> TestKind -> String -> [String] -> IO ()
execTests darcs_path k fmt tests = do
let dir = (flat k) ++ "-" ++ fmt ++ ".dir"
rmRf dir
cloneTree (show k) dir
withCurrentDirectory dir $ do
createDirectory ".darcs"
when (not $ null fmt) $ appendFile ".darcs/defaults" $ "ALL " ++ fmt ++ "\n"
putStrLn $ "Running tests for format: " ++ fmt
exec
where exec = do
fs <- case tests of
[] -> sort `fmap` getDirectoryContents "."
x -> return x
cwd <- getCurrentDirectory
let run = filter isTest fs
res <- Harness.runTests (Just darcs_path) cwd run
when ((not res) && (k /= Bug)) $ fail "Tests failed"
return ()
individualTests :: FilePath -> [String] -> IO ()
individualTests darcs_path tests = do
run <- concat `fmap` mapM find tests
sequence_ [ do exec kind [test | (kind', test) <- run, kind' == kind]
| kind <- [Test, Bug, Network] ]
where tryin w t' = [w t', w (t' ++ ".sh")]
exec _ [] = return ()
exec kind to_run = allTests darcs_path kind to_run
find t = do
let c = [t, t ++ ".sh"] ++ tryin "tests" t ++ tryin "bugs" t
++ tryin "network" t
run <- map kindify `fmap` filterM doesFileExist c
return $ take 1 run
kindify test = case splitDirectories test of
[p, y] -> (parse_kind p, y)
_ -> error $ "Bad format in " ++ test ++
": expected type/test"
parse_kind "tests" = Test
parse_kind "bugs" = Bug
parse_kind "network" = Network
parse_kind x = error $ "Test prefix must be one of " ++
"[tests, bugs, network] in " ++ x
allTests :: FilePath -> TestKind -> [String] -> IO ()
allTests darcs_path k s =
do test `mapM` repotypes
return ()
where repotypes = ["darcs-2", "hashed", "old-fashioned-inventory"]
test x = execTests darcs_path k x s
-------------------------------------------------------
-- Utility functions (FIXME)
-- copy & paste & edit: darcs wants to share these
--
withCurrentDirectory :: FilePath -> IO a -> IO a
withCurrentDirectory name m =
bracket
(do cwd <- getCurrentDirectory
when (name /= "") (setCurrentDirectory name)
return cwd)
(\oldwd -> setCurrentDirectory oldwd `catch` (\_ -> return ()))
(const m)
cloneTree :: FilePath -> FilePath -> IO ()
cloneTree = cloneTreeExcept []
cloneTreeExcept :: [FilePath] -> FilePath -> FilePath -> IO ()
cloneTreeExcept except source dest =
do isdir <- doesDirectoryExist source
if isdir then do
createDirectoryIfMissing True dest
fps <- getDirectoryContents source
let fps' = filter (`notElem` (".":"..":except)) fps
mk_source fp = source ++ "/" ++ fp
mk_dest fp = dest ++ "/" ++ fp
zipWithM_ cloneSubTree (map mk_source fps') (map mk_dest fps')
else fail ("cloneTreeExcept: Bad source " ++ source)
`catch` fail ("cloneTreeExcept: Bad source " ++ source)
cloneSubTree :: FilePath -> FilePath -> IO ()
cloneSubTree source dest =
do isdir <- doesDirectoryExist source
isfile <- doesFileExist source
if isdir then do
createDirectory dest
fps <- getDirectoryContents source
let fps' = filter (`notElem` [".", ".."]) fps
mk_source fp = source ++ "/" ++ fp
mk_dest fp = dest ++ "/" ++ fp
zipWithM_ cloneSubTree (map mk_source fps') (map mk_dest fps')
else if isfile then do
cloneFile source dest
else fail ("cloneSubTree: Bad source "++ source)
`catch` (\e -> if isDoesNotExistError e
then return ()
else ioError e)
cloneFile :: FilePath -> FilePath -> IO ()
cloneFile = copyFile
rmRf :: FilePath -> IO ()
rmRf path = do
isdir <- doesDirectoryExist path
isf <- doesFileExist path
when isdir $ removeDirectoryRecursive path
when isf $ removeFile path
return ()
-- (END FIXME)
\end{code}
#! /usr/bin/env runhaskell
\begin{code}
{-# LANGUAGE TemplateHaskell #-}
{-# OPTIONS -Wall #-}
-----------------------------------------------------------------------------
-- |
-- Module : Setup
-- Copyright : (c) 2008, 2009 Universiteit Utrecht
-- License : BSD3
--
-- Maintainer : generics@haskell.org
-----------------------------------------------------------------------------
module Main (main) where
import System.Cmd
( system
)
import System.FilePath
( ()
)
import Data.Version
( Version(..)
)
import Distribution.Simple
( defaultMainWithHooks
, simpleUserHooks
, UserHooks(runTests, haddockHook, buildHook)
, Args
)
import Distribution.Simple.LocalBuildInfo
( LocalBuildInfo(..)
)
import Distribution.Simple.Program
( userSpecifyArgs
)
import Distribution.Simple.Setup
( HaddockFlags
, BuildFlags
)
import Distribution.Package
import Distribution.PackageDescription
( PackageDescription(..)
, BuildInfo(..)
, Library(..)
, Executable(..)
)
main :: IO ()
main = defaultMainWithHooks hooks
where
hooks = simpleUserHooks
{ runTests = runTests'
, haddockHook = haddockHook'
, buildHook = buildHook'
}
-- Run a 'test' binary that gets built when configured with '-ftest'.
runTests' :: Args -> Bool -> PackageDescription -> LocalBuildInfo -> IO ()
runTests' _ _ _ _ = system cmd >> return ()
where testdir = "dist" "build" "test"
testcmd = "." "test"
cmd = "cd " ++ testdir ++ " && " ++ testcmd
-- Define __HADDOCK__ for CPP when running haddock. This is a workaround for
-- Haddock not building the documentation due to some issue with Template
-- Haskell.
haddockHook' :: PackageDescription -> LocalBuildInfo -> UserHooks -> HaddockFlags -> IO ()
haddockHook' pkg lbi =
haddockHook simpleUserHooks pkg (lbi { withPrograms = p })
where
p = userSpecifyArgs "haddock" ["--optghc=-D__HADDOCK__"] (withPrograms lbi)
-- Insert CPP flag for building with template-haskell versions >= 2.3. This was
-- previously done in the .cabal file, but it was not backwards compatible with
-- Cabal 1.2. This should work with Cabal from 1.2 to 1.6 at least.
buildHook' :: PackageDescription -> LocalBuildInfo -> UserHooks -> BuildFlags -> IO ()
buildHook' pkg lbi hooks flags = do
buildHook simpleUserHooks pkg (lbi { localPkgDescr = newPkgDescr }) hooks flags
where
-- Old local package description
oldPkgDescr = localPkgDescr lbi
-- New local package description
newPkgDescr =
case thVersion of
Nothing ->
oldPkgDescr
Just version ->
if version >= Version [2,3] []
then
oldPkgDescr
{ library = addThCppToLibrary (library oldPkgDescr)
, executables = map addThCppToExec (executables oldPkgDescr)
}
else
oldPkgDescr
-- Template Haskell package name
thPackageName = mkPackageName "template-haskell"
mkPackageName :: (Read a) => String -> a
mkPackageName nm =
fst $ head $ reads shownNm ++ reads ("PackageName " ++ shownNm)
where
shownNm = show nm
-- template-haskell version
thVersion = findThVersion (packageDeps lbi)
-- CPP options for template-haskell >= 2.3
thCppOpt = "-DTH_LOC_DERIVEREP"
-- Find the version of the template-haskell package
findThVersion [] = Nothing
findThVersion (PackageIdentifier name version:ps)
| name == thPackageName = Just version
| otherwise = findThVersion ps
-- Add the template-haskell CPP flag to a BuildInfo
addThCppToBuildInfo :: BuildInfo -> BuildInfo
addThCppToBuildInfo bi =
bi { cppOptions = thCppOpt : cppOptions bi }
-- Add the template-haskell CPP flag to a library package description
addThCppToLibrary :: Maybe Library -> Maybe Library
addThCppToLibrary ml = do
lib <- ml
return (lib { libBuildInfo = addThCppToBuildInfo (libBuildInfo lib) })
-- Add the template-haskell CPP flag to an executable package description
addThCppToExec :: Executable -> Executable
addThCppToExec exec =
exec { buildInfo = addThCppToBuildInfo (buildInfo exec) }
\end{code}
module Main where
import Distribution.Simple
import Data.Encoding.Preprocessor.Mapping
import Data.Encoding.Preprocessor.XMLMappingBuilder
main = defaultMainWithHooks (simpleUserHooks
{hookedPreProcessors = (("mapping",\_ _ -> mappingPreprocessor)
:("mapping2",\_ _ -> mappingPreprocessor)
:("xml",\_ _ -> xmlPreprocessor)
:(hookedPreProcessors simpleUserHooks)
)
})
import Distribution.Simple
import Distribution.PackageDescription
import System
-- After Epic is built, we need a run time system.
-- FIXME: This is probably all done the wrong way, I don't really understand
-- Cabal properly...
buildLib args flags desc local
= do exit <- system "make -C evm"
return ()
-- This is a hack. I don't know how to tell cabal that a data file needs
-- installing but shouldn't be in the distribution. And it won't make the
-- distribution if it's not there, so instead I just delete
-- the file after configure.
postConfLib args flags desc local
= do exit <- system "make -C evm clean"
return ()
main = defaultMainWithHooks (simpleUserHooks { postBuild = buildLib,
postConf = postConfLib})
import Distribution.Simple
import Distribution.Package
import Distribution.Simple.Program(defaultProgramConfiguration)
import Distribution.PackageDescription
import Distribution.Simple.Setup
import Distribution.Simple.Command
import Distribution.Simple.Utils (rawSystemExit, cabalVersion)
import Distribution.License (License(..))
import Distribution.Version
( Version(..) )
import Distribution.Text
( display )
import System.Environment (getArgs, getProgName)
import Data.List (intersperse)
import System.Exit
make = getArgs >>= makeHelper
makeHelper :: [String] -> IO ()
makeHelper args =
case commandsRun globalCommand commands args of
CommandHelp help -> printHelp help
CommandList opts -> printOptionsList opts
CommandErrors errs -> printErrors errs
CommandReadyToGo (flags, commandParse) ->
case commandParse of
_ | fromFlag (globalVersion flags) -> printVersion
| fromFlag (globalNumericVersion flags) -> printNumericVersion
CommandHelp help -> printHelp help
CommandList opts -> printOptionsList opts
CommandErrors errs -> printErrors errs
CommandReadyToGo action -> action
where
printHelp help = getProgName >>= putStr . help
printOptionsList = putStr . unlines
printErrors errs = do
putStr (concat (intersperse "\n" errs))
exitWith (ExitFailure 1)
printNumericVersion = putStrLn $ display cabalVersion
printVersion = putStrLn $ "Cabal library version "
++ display cabalVersion
progs = defaultProgramConfiguration
commands =
[configureCommand progs `commandAddAction` configureAction
,buildCommand progs `commandAddAction` buildAction
,installCommand `commandAddAction` installAction
,copyCommand `commandAddAction` copyAction
,cleanCommand `commandAddAction` cleanAction
,registerCommand `commandAddAction` bugger_all
,unregisterCommand `commandAddAction` bugger_all
,haddockCommand `commandAddAction` bugger_all
]
bugger_all =
const $ return $ return ( )
configureAction :: ConfigFlags -> [String] -> IO ()
configureAction flags args = do
noExtraFlags args
let verbosity = fromFlag (configVerbosity flags)
rawSystemExit verbosity "sh" $
"configure"
: configureArgs backwardsCompatHack flags
where backwardsCompatHack = True
copyAction :: CopyFlags -> [String] -> IO ()
copyAction flags args = do
noExtraFlags args
let destArgs = case fromFlag $ copyDest flags of
NoCopyDest -> ["install"]
CopyTo path -> ["copy", "destdir=" ++ path]
CopyPrefix path -> ["install", "prefix=" ++ path]
-- CopyPrefix is backwards compat, DEPRECATED
rawSystemExit (fromFlag $ copyVerbosity flags) "make" destArgs
installAction :: InstallFlags -> [String] -> IO ()
installAction flags args = do
noExtraFlags args
rawSystemExit (fromFlag $ installVerbosity flags) "make" ["install"]
buildAction :: BuildFlags -> [String] -> IO ()
buildAction flags args = do
noExtraFlags args
rawSystemExit (fromFlag $ buildVerbosity flags) "make" []
cleanAction :: CleanFlags -> [String] -> IO ()
cleanAction flags args = do
noExtraFlags args
rawSystemExit (fromFlag $ cleanVerbosity flags) "make" ["clean"]
sdistAction :: SDistFlags -> [String] -> IO ()
sdistAction flags args = do
noExtraFlags args
rawSystemExit (fromFlag $ sDistVerbosity flags) "make" ["dist"]
main = do
make
defaultMain
#!/usr/bin/env runhaskell
\begin{code}
{-# OPTIONS -Wall -cpp #-}
import Control.Monad
import Distribution.PackageDescription
import Distribution.Simple
import Distribution.Simple.LocalBuildInfo
import Distribution.Simple.Utils
import System.Cmd
import System.FilePath
import System.Exit
import System.Directory
import Control.Exception
main :: IO ()
main = do
let hooks = simpleUserHooks {
buildHook = build_primitive_sources
$ buildHook simpleUserHooks
}
defaultMainWithHooks hooks
\end{code}
Mostly snarfed from ghc-prim's Setup.hs.
\begin{code}
type Hook a = PackageDescription -> LocalBuildInfo -> UserHooks -> a -> IO ()
-- NOTE: I'm not sure whether this code works, as of 9/2009
-- (it assumes we're in the GHC tree, for one thing)
-- Hack: If PrimEnv.hs exists *and* genprimopcode or
-- primops.txt doesn't exist, don't rebuild PrimEnv.hs
build_primitive_sources :: Hook a -> Hook a
build_primitive_sources f pd lbi uhs x
= do when (compilerFlavor (compiler lbi) == GHC) $ do
let genprimopcode = joinPath ["..", "..", "utils",
"genprimopcode", "genprimopcode"]
primops = joinPath ["..", "..", "compiler", "prelude",
"primops.txt"]
primhs = joinPath ["Language", "Core", "PrimEnv.hs"]
primhs_tmp = addExtension primhs "tmp"
primEnvExists <- doesFileExist primhs
genprimopcodeExists <- doesFileExist genprimopcode
primopsExists <- doesFileExist primops
unless (primEnvExists && not genprimopcodeExists && not primopsExists) $ do
maybeExit $ system (genprimopcode ++ " --make-ext-core-source < "
++ primops ++ " > " ++ primhs_tmp)
maybeUpdateFile primhs_tmp primhs
maybeExit $ system ("make -C lib/GHC_ExtCore")
f pd lbi uhs x
-- Replace a file only if the new version is different from the old.
-- This prevents make from doing unnecessary work after we run 'setup makefile'
maybeUpdateFile :: FilePath -> FilePath -> IO ()
maybeUpdateFile source target = do
r <- rawSystem "cmp" ["-s" {-quiet-}, source, target]
case r of
ExitSuccess -> removeFile source
ExitFailure _ -> do
#if __GLASGOW_HASKELL__ >= 610
(try :: IO () -> IO (Either IOException ()))
#else
try
#endif
(removeFile target)
renameFile source target
\end{code}#!/usr/bin/env runhaskell
import Control.Monad (when)
import Distribution.PreProcess
import Distribution.Simple
import Distribution.Simple.LocalBuildInfo
import Distribution.Simple.Utils (rawSystemVerbose, dieWithLocation)
import System.Cmd (system)
import System.Directory (getModificationTime, doesFileExist)
main = defaultMainWithHooks hooks
hooks = defaultUserHooks { hookedPreProcessors = [trhsx, c2hs] }
trhsx :: PPSuffixHandler
trhsx = ("fhs", f) where
f buildInfo localBuildInfo inFile outFile verbose = do
when (verbose > 3) $
putStrLn ("checking that preprocessor is up-to-date")
let [pIn, pOut] = ["Preprocessor/Hsx/Parser."++s | s <- ["ly","hs"]]
exists <- doesFileExist pOut
runHappy <- if not exists then return True else do
[tIn, tOut] <- mapM getModificationTime [pIn, pOut]
return (tIn > tOut)
when runHappy $ system ("happy "++pIn) >> return ()
system ("ghc --make Preprocessor/Main.hs -o preprocessor")
when (verbose > 0) $
putStrLn ("preprocessing "++inFile++" to "++outFile)
writeFile outFile ("-- GENERATED file. Edit the ORIGINAL "++inFile++
" instead.\n")
system ("./preprocessor "++inFile++" >> "++outFile)
c2hs :: PPSuffixHandler
c2hs = ("chs", f) where
f buildInfo localBuildInfo inFile outFile verbose = do
when (verbose > 0) $
putStrLn $ "preprocess "++inFile++" to "++outFile
maybe (dieWithLocation inFile Nothing "no c2hs available")
(\c2hs -> rawSystemVerbose verbose c2hs
["--cppopts", "-D\"__attribute__(A)= \"",
"-o", outFile, inFile])
(withC2hs localBuildInfo)
#! /usr/bin/env runhaskell
module Main (main) where
import Control.Monad (liftM, when)
import Data.List (intersperse)
import Distribution.Simple
import Distribution.Simple.Setup
import Distribution.Simple.LocalBuildInfo
import Distribution.PackageDescription
import System.Process
import System.Exit
import System.Directory
import System.FilePath
main :: IO ()
main = defaultMainWithHooks simpleUserHooks{runTests=forsydeTests,
postInst=forsydePostInst,
postCopy=forsydePostCopy}
forsydeTests :: Args -> Bool -> PackageDescription -> LocalBuildInfo -> IO ()
forsydeTests _ _ _ _ = do
e <- runCommandMsg "runghc"
["-itests/properties", "-iexamples", "tests/properties/Main.hs"]
when (not e) exitFailure
forsydePostInst :: Args -> InstallFlags -> PackageDescription ->
LocalBuildInfo -> IO ()
forsydePostInst _ _ = compile_forsyde_vhd NoCopyDest
forsydePostCopy :: Args -> CopyFlags -> PackageDescription ->
LocalBuildInfo -> IO ()
forsydePostCopy _ cf = compile_forsyde_vhd (copyDest cf)
-- NOTE: Most of this code is duplicated from ForSyDe.Backend.VHDL.Modelsim,
-- however, it allows Setup.hs to be selfcontained
-- Compile forsyde.vhd if possible, showing what's going on to the end user
compile_forsyde_vhd :: CopyDest -> PackageDescription -> LocalBuildInfo
-> IO ()
compile_forsyde_vhd cd pd lbi = do
putStrLn "Compiling ForSyDe's VHDL library with Modelsim ..."
(ifNot isModelsimInstalled
(modelsimError "Modelsim executables could not be found.")) <&&>
(ifNot (do_compile_forsyde_vhd forsyde_vhd_dir)
( modelsimError "Compilation failed.")) <&&>
(putStrLn "Compilation succeded." >> return True)
return ()
where
forsyde_vhd_dir = (datadir $ absoluteInstallDirs pd lbi cd)
"lib"
modelsimError err = putStrLn $
"Error: " ++ err ++ "\n" ++
" ForSyDe will work, but you will not be able to automatically\n" ++
" simulate the ForSyDe-generated VHDL models with Modelsim\n" ++
" (see function ForSyDe.Backend.VHDL.writeAndSimulateVHDL).\n\n" ++
" In order to fix this, make sure that the Modelsim executables " ++
" can be found in PATH and reinstall ForSyDe"
-- Look for modelsim executables
isModelsimInstalled :: IO Bool
isModelsimInstalled = executablePresent "vlib" <&&>
executablePresent "vmap" <&&>
executablePresent "vcom"
where executablePresent = (liftM (maybe False (\_-> True))) .findExecutable
-- Create a modelsim library for forsyde.vhd
-- in the same directory in which forsyde.vhd was copied
do_compile_forsyde_vhd :: FilePath -- ^ absolute directory which
-- forsyde.vhd was copied into
-> IO Bool
do_compile_forsyde_vhd dir =
(runCommandMsg "vlib" [dir "modelsim"]) <&&>
(runCommandMsg
"vcom" ["-93", "-quiet", "-nologo", "-work", dir "modelsim",
dir "forsyde.vhd"])
where runWait :: String -> FilePath -> [String] -> IO Bool
runWait msg proc args = do
putStrLn msg
h <- runProcess proc args (Just dir) Nothing Nothing Nothing Nothing
code <- waitForProcess h
return $ code == ExitSuccess
-- | run a command showing what's being run
runCommandMsg :: String -- ^ Command to execute
-> [String] -- ^ Command arguments
-> IO Bool
runCommandMsg command args = runWait msg command args
where msg = "Running: " ++ command ++ " " ++ (concat $ intersperse " " args)
-- | Run a process, previously announcing a message and waiting for it
-- to finnish its execution.
runWait :: String -- ^ message to show
-> FilePath -- ^ command to execute
-> [String] -- ^ command arguments
-> IO Bool -- ^ Did the execution end succesfully?
runWait msg proc args = do
putStrLn msg
h <- runProcess proc args Nothing Nothing Nothing Nothing Nothing
code <- waitForProcess h
return $ code == ExitSuccess
-- | short-circuit and for monads
(<&&>) :: Monad m => m Bool -> m Bool -> m Bool
x <&&> y = do p <- x
if p then y else return False
-- | execute an action when the argument is False
-- and return the boolean value
ifNot :: Monad m => m Bool -> m () -> m Bool
ifNot x a = do p <- x
when (not p) a
return p#!/usr/bin/runhaskell
import Distribution.Franchise
import Data.List ( sort, isSuffixOf, isPrefixOf )
configure = do copyright "Copyright 2008 David Roundy"
license "BSD3"
addExtraData "category" "Distribution"
addExtraData "synopsis"
"A package for configuring and building Haskell software"
addExtraData "description" $ unlines
["",
" Franchise is an easy-to use package for building Haskell",
" software. Unlike Cabal, you aren't required to track every",
" possible dependency in every possible build condition. In",
" addition, you are not required to use an external tool such as",
" autoconf in order to configure the build based on which",
" packages, libraries and tools are present.",
"",
" Note: the cabal dependencies are autogenerated, and approximate."]
ghcFlags ["-threaded","-O2","-Wall"]
main = build [] configure $ do -- versionFromDarcs doesn't go in configure
-- because we want to rerun it with each
-- build rather than waiting for the user to
-- run Setup.hs configure again.
versionFromDarcs
buildDoc
darcsDist "franchise" ["franchise.cabal"]
package "franchise" ["Distribution.Franchise"] []
buildDoc = do rm_rf "doc/tests"
addTarget $ ["*webpage*"] :< ["*manual*","index.html"] |<- defaultRule
addTarget $ ["index.html"] :< ["doc/home.txt"] |<- defaultRule { make = makeroot }
alltests <- mapDirectory buildOneDoc "doc"
here <- pwd
let prepareForTest = -- make a local install of franchise for test
do setEnv "HOME" (here++"/doc/tests")
pkgFlags ["--user"]
installPackageInto "franchise" (here++"/doc/tests/lib")
test prepareForTest $ concatMap snd alltests
withDirectory "doc" $ do buildIndex (concatMap fst alltests)
htmls <- concat `fmap` mapM buildHtml (concatMap fst alltests)
addTarget $ ["*manual*","*html*"] :<
("manual/index.html":htmls) |<- defaultRule
where buildOneDoc f | not (".txt.in" `isSuffixOf` f) = return ([],[])
buildOneDoc f = do tests0@(txtf:_) <- splitFile f (\x -> ("manual/"++take (length f-3) f,
unlines (concatMap purge $ lines x))
: splitf (lines x))
let tests = map splitPath $
filter (".sh" `isSuffixOf`) $
filter ("tests/" `isPrefixOf`) tests0
ts <- mapM (\ (d, t) -> withDirectory d $ testOne "bash" t) tests
return ([txtf],ts)
buildHtml f = withProgram "markdown" [] $ \markdown ->
do withd <- rememberDirectory
x <- cat f
let makehtml = withd $ do putS $ "["++markdown++"] doc/manual/"++f
html <- systemOut markdown [f]
mkFile htmlname $
unlines [htmlHead "../doc.css" x,html,htmlTail]
htmlname = take (length f - 4) f++".html"
addTarget $ [htmlname] :< [f]
|<- defaultRule { make = const makehtml }
return [htmlname]
buildIndex inps =
withProgram "markdown" [] $ \markdown ->
do withd <- rememberDirectory
let mklink mkdnf = do title <- (head . filter (not . null) . lines) `fmap` cat mkdnf
return $ '[':title++"]("++
drop 7 (take (length mkdnf-4) mkdnf)++".html)\n"
makeindex _ = withd $
do putS $ "["++markdown++"] doc/manual.txt"
indhead <- cat "manual.txt"
links <- mapM mklink $ sort inps
html <- systemInOut markdown [] $
indhead ++ "\n\n"++unlines links
mkFile "manual/index.html" $
unlines [htmlHead "../doc.css" indhead,html,htmlTail]
addTarget $ ["manual/index.html"] :< ("manual.txt":inps)
|<- defaultRule { make = makeindex }
makeroot _ = withProgram "markdown" [] $ \markdown ->
do putS $ "["++markdown++"] doc/home.txt"
html <- systemOut markdown ["doc/home.txt"]
mkFile "index.html" $
unlines [htmlHead "doc/doc.css" "Franchise",html,htmlTail]
purge l | "...." `isPrefixOf` l = []
| otherwise = case stripPrefix "file: " l of
Just fn -> ['*':fn++":*",""] -- need blank line to get code mode
Nothing -> [l]
splitf (x:r) =
case stripPrefix "file: " x of
Nothing -> splitf r
Just fn -> case break (\l -> not $ " " `isPrefixOf` l || "...." `isPrefixOf` l) r of
(fc, rest) ->
(fn, unlines $ map (drop 4) fc) : splitf rest
splitf [] = []
splitOn x (c:cs) = case stripPrefix x (c:cs) of
Just cs' -> Just ([],cs')
Nothing -> do (cs1,cs2) <- splitOn x cs
Just (c:cs1,cs2)
splitOn _ [] = Nothing
htmlHead css x = unlines ["\n",
"",
"",
unwords ["",head $ filter (not . null) $ lines x," "],
"",
"",
""]
htmlTail = unlines ["",
""]
{-# LANGUAGE CPP #-}
import Control.Monad (foldM_, forM_)
import Data.Maybe ( fromMaybe )
import System.Cmd
import System.Exit
import System.Info (os)
import System.FilePath
import System.Directory ( doesFileExist, copyFile, removeFile, createDirectoryIfMissing )
import Distribution.PackageDescription
import Distribution.Simple.Setup
import Distribution.Simple
import Distribution.Simple.LocalBuildInfo
#ifndef WIN32
import System.Posix.Files (fileMode, getFileStatus, setFileMode,
ownerExecuteMode, groupExecuteMode, otherExecuteMode)
import Data.Bits ( (.|.) )
#endif
main :: IO ()
main = defaultMainWithHooks $ addMacHook simpleUserHooks
where
addMacHook h =
case os of
"darwin" -> h { postInst = appBundleHook } -- is it OK to treat darwin as synonymous with MacOS X?
_ -> h
appBundleHook :: Args -> InstallFlags -> PackageDescription -> LocalBuildInfo -> IO ()
appBundleHook _ _ pkg localb =
forM_ exes $ \app ->
do createAppBundle theBindir (buildDir localb app app)
customiseAppBundle (appBundlePath theBindir app) app
`catch` \err -> putStrLn $ "Warning: could not customise bundle for " ++ app ++ ": " ++ show err
removeFile (theBindir app)
createAppBundleWrapper theBindir app
where
theBindir = bindir $ absoluteInstallDirs pkg localb NoCopyDest
exes = fromMaybe (map exeName $ executables pkg) mRestrictTo
-- ----------------------------------------------------------------------
-- helper code for application bundles
-- ----------------------------------------------------------------------
-- | 'createAppBundle' @d p@ - creates an application bundle in @d@
-- for program @p@, assuming that @d@ already exists and is a directory.
-- Note that only the filename part of @p@ is used.
createAppBundle :: FilePath -> FilePath -> IO ()
createAppBundle dir p =
do createDirectoryIfMissing False $ bundle
createDirectoryIfMissing True $ bundleBin
createDirectoryIfMissing True $ bundleRsrc
copyFile p (bundleBin takeFileName p)
where
bundle = appBundlePath dir p
bundleBin = bundle "Contents/MacOS"
bundleRsrc = bundle "Contents/Resources"
-- | 'createAppBundleWrapper' @d p@ - creates a script in @d@ that calls
-- @p@ from the application bundle @d takeFileName p <.> "app"@
createAppBundleWrapper :: FilePath -> FilePath -> IO ()
createAppBundleWrapper bindir p =
do writeFile scriptFile scriptTxt
makeExecutable scriptFile
where
scriptFile = bindir takeFileName p
scriptTxt = "`dirname $0`" appBundlePath "." p "Contents/MacOS" takeFileName p ++ " \"$@\""
appBundlePath :: FilePath -> FilePath -> FilePath
appBundlePath dir p = dir takeFileName p <.> "app"
-- ----------------------------------------------------------------------
-- utilities
-- ----------------------------------------------------------------------
makeExecutable :: FilePath -> IO ()
#ifdef WIN32
makeExecutable = const (return ())
#else
makeExecutable f =
do st <- getFileStatus f
let m = fileMode st
m2 = m .|. ownerExecuteMode .|. groupExecuteMode .|. otherExecuteMode
setFileMode f m2
#endif
-- ----------------------------------------------------------------------
-- customisations
-- ----------------------------------------------------------------------
-- | Put here IO actions needed to add any fancy things (eg icons)
-- you want to your application bundle.
customiseAppBundle :: FilePath -- ^ app bundle path
-> FilePath -- ^ full path to original binary
-> IO ()
customiseAppBundle bundleDir p =
case takeFileName p of
"geni" ->
do hasRez <- doesFileExist "/Developer/Tools/Rez"
if hasRez
then do -- set the icon
copyFile "etc/macstuff/Info.plist" (bundleDir "Contents/Info.plist")
copyFile "etc/macstuff/wxmac.icns" (bundleDir "Contents/Resources/wxmac.icns")
-- no idea what this does
system ("/Developer/Tools/Rez -t APPL Carbon.r -o " ++ bundleDir "Contents/MacOS/geni")
writeFile (bundleDir "PkgInfo") "APPL????"
-- tell Finder about the icon
system ("/Developer/Tools/SetFile -a C " ++ bundleDir "Contents")
return ()
else putStrLn "Developer Tools not found. Too bad; no fancy icons for you."
"" -> return ()
-- | Put here the list of executables which contain a GUI. If they all
-- contain a GUI (or you don't really care that much), just put Nothing
mRestrictTo :: Maybe [String]
mRestrictTo = Just ["geni"]
import Distribution.Simple
import Distribution.Simple.Setup
import Distribution.PackageDescription
import Distribution.Simple.LocalBuildInfo
import Distribution.InstalledPackageInfo
import Distribution.Simple.Program
import Distribution.Simple.PackageIndex as Pkg
import System.Exit
import System.IO
import Data.IORef
import Data.Char
import Data.Maybe
main = defaultMainWithHooks simpleUserHooks {
postConf = defaultPostConf,
preBuild = readHook,
preCopy = readHook,
preInst = readHook,
preHscolour = readHook,
preHaddock = readHook,
preReg = readHook,
preUnreg = readHook
}
where
defaultPostConf :: Args -> ConfigFlags -> PackageDescription -> LocalBuildInfo -> IO ()
defaultPostConf args flags pkgdescr lbi = do
libdir_ <- rawSystemProgramStdoutConf (fromFlag (configVerbosity flags))
ghcProgram (withPrograms lbi) ["--print-libdir"]
let libdir = reverse $ dropWhile isSpace $ reverse libdir_
ghc_pkg = case lookupProgram ghcPkgProgram (withPrograms lbi) of
Just p -> programPath p
Nothing -> error "ghc-pkg was not found"
ghc = case lookupProgram ghcProgram (withPrograms lbi) of
Just p -> programPath p
Nothing -> error "ghc was not found"
-- figure out docdir from base's haddock-html field
base_pkg = case searchByName (installedPkgs lbi) "base" of
None -> error "no base package"
Unambiguous (x:_) -> x
_ -> error "base ambiguous"
base_html = case haddockHTMLs base_pkg of
[] -> ""
(x:_) -> x
docdir = fromMaybe base_html $
fmap reverse (stripPrefix (reverse "/libraries/base")
(reverse base_html))
let buildinfo = emptyBuildInfo{
cppOptions = ["-DGHC_PATHS_GHC_PKG=" ++ show ghc_pkg,
"-DGHC_PATHS_GHC=" ++ show ghc,
"-DGHC_PATHS_LIBDIR=" ++ show libdir,
"-DGHC_PATHS_DOCDIR=" ++ show docdir ]
}
writeFile file (show buildinfo)
readHook :: Args -> a -> IO HookedBuildInfo
readHook _ _ = do
str <- readFile file
return (Just (read str), [])
file = "ghc-paths.buildinfo"
die :: String -> IO a
die msg = do
hFlush stdout
hPutStr stderr msg
exitWith (ExitFailure 1)
stripPrefix :: Eq a => [a] -> [a] -> Maybe [a]
stripPrefix [] ys = Just ys
stripPrefix (x:xs) (y:ys)
| x == y = stripPrefix xs ys
stripPrefix _ _ = Nothing
import Distribution.Simple import System main = system "DtdToHaskell src/Script.dtd >src/Script.hs">> defaultMain
#!/usr/bin/env runhaskell
import Distribution.Simple
( simpleUserHooks
, UserHooks
, defaultMainWithHooks
)
import System.Cmd ( system )
import System ( getArgs )
myHooks :: UserHooks
myHooks = simpleUserHooks
main :: IO ()
main = do args <- getArgs
processArgs args
processArgs :: [ String ] -> IO ()
processArgs ( "happraise" : rest) =
do _exitCode <- system haCommand
return ()
where
haCommand :: String
haCommand = unwords ("happraise `darcs query manifest`" : rest)
processArgs _ = defaultMainWithHooks myHooks
#!/usr/bin/env runghc
module Main where
import Distribution.Simple
import Distribution.Simple.Program
trhsxProgram = simpleProgram "trhsx"
main :: IO ()
main = defaultMainWithHooks simpleUserHooks {
hookedPrograms = [trhsxProgram]
}
#!/usr/bin/runhaskell
\begin{code}
module Main where
import Distribution.PackageDescription (PackageDescription(..))
import Distribution.Simple.Setup ( BuildFlags(..), buildVerbose )
import Distribution.Simple ( defaultMainWithHooks, defaultUserHooks, UserHooks(..) )
import Distribution.Simple.LocalBuildInfo ( LocalBuildInfo(..) )
import Distribution.Simple.Program
import System.FilePath (())
import System.IO.Error ( try )
import System.Directory (removeFile)
main :: IO ()
main = defaultMainWithHooks defaultUserHooks{ hookedPrograms = [perlProgram],
postBuild = myPostBuild,
postClean = myPostClean,
copyHook = myCopy,
instHook = myInstall }
perlProgram = simpleProgram "perl"
-- hack to turn cpp-style '# 27 "GenericTemplate.hs"' into
-- '{-# LINE 27 "GenericTemplate.hs" #-}'.
crazy_perl_regexp =
"s/^#\\s+(\\d+)\\s+(\"[^\"]*\")/{-# LINE \\1 \\2 #-}/g;s/\\$(Id:.*)\\$/\\1/g"
myPostBuild _ flags _ lbi = do
let runProgram p = rawSystemProgramConf (buildVerbose flags) p (withPrograms lbi)
cpp_template src dst opts = do
runProgram ghcProgram (["-o", dst, "-E", "-cpp", "templates" src] ++ opts)
runProgram perlProgram ["-i.bak", "-pe", crazy_perl_regexp, dst]
sequence_ ([ cpp_template "GenericTemplate.hs" dst opts | (dst,opts) <- templates ] ++
[ cpp_template "GLR_Base.lhs" dst opts | (dst,opts) <- glr_base_templates ] ++
[ cpp_template "GLR_Lib.lhs" dst opts | (dst,opts) <- glr_templates ])
myPostClean _ _ _ _ = mapM_ (try . removeFile) all_template_files
myInstall pkg_descr lbi hooks flags =
instHook defaultUserHooks pkg_descr' lbi hooks flags
where pkg_descr' = pkg_descr {
dataFiles = dataFiles pkg_descr ++ all_template_files
}
myCopy pkg_descr lbi hooks copy_flags =
copyHook defaultUserHooks pkg_descr' lbi hooks copy_flags
where pkg_descr' = pkg_descr {
dataFiles = dataFiles pkg_descr ++ all_template_files
}
all_template_files :: [FilePath]
all_template_files = map fst (templates ++ glr_base_templates ++ glr_templates)
templates :: [(FilePath,[String])]
templates = [
("HappyTemplate" , []),
("HappyTemplate-ghc" , ["-DHAPPY_GHC"]),
("HappyTemplate-coerce" , ["-DHAPPY_GHC","-DHAPPY_COERCE"]),
("HappyTemplate-arrays" , ["-DHAPPY_ARRAY"]),
("HappyTemplate-arrays-ghc" , ["-DHAPPY_ARRAY","-DHAPPY_GHC"]),
("HappyTemplate-arrays-coerce" , ["-DHAPPY_ARRAY","-DHAPPY_GHC","-DHAPPY_COERCE"]),
("HappyTemplate-arrays-debug" , ["-DHAPPY_ARRAY","-DHAPPY_DEBUG"]),
("HappyTemplate-arrays-ghc-debug" , ["-DHAPPY_ARRAY","-DHAPPY_GHC","-DHAPPY_DEBUG"]),
("HappyTemplate-arrays-coerce-debug" , ["-DHAPPY_ARRAY","-DHAPPY_GHC","-DHAPPY_COERCE","-DHAPPY_DEBUG"])
]
glr_base_templates :: [(FilePath,[String])]
glr_base_templates = [
("GLR_Base" , [])
]
glr_templates :: [(FilePath,[String])]
glr_templates = [
("GLR_Lib" , []),
("GLR_Lib-ghc" , ["-DHAPPY_GHC"]),
("GLR_Lib-ghc-debug" , ["-DHAPPY_GHC", "-DHAPPY_DEBUG"])
]
\end{code}
import Distribution.Simple
( defaultMainWithHooks, UserHooks(..), simpleUserHooks )
import Distribution.Simple.LocalBuildInfo( LocalBuildInfo(..) )
import Distribution.PackageDescription
( PackageDescription(executables), Executable(buildInfo, exeName)
, BuildInfo(customFieldsBI), emptyBuildInfo
, updatePackageDescription, cppOptions, ccOptions )
import Distribution.Simple.Setup
(buildVerbosity, copyDest, copyVerbosity, fromFlag,
haddockVerbosity, installVerbosity, sDistVerbosity)
import Distribution.Verbosity
( Verbosity )
import System( system, exitWith )
import System.FilePath( () )
-- for endianness check
import Foreign.Marshal.Utils ( with )
import Data.Word ( Word8, Word32 )
import Foreign.Storable ( peek )
import Foreign.Ptr ( castPtr )
hst = "hashed-storage-test"
main :: IO ()
main = defaultMainWithHooks simpleUserHooks {
runTests = \ _ _ _ lbi -> do
exitWith =<< system (buildDir lbi hst hst),
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)
}
commonBuildHook :: (UserHooks -> PackageDescription -> LocalBuildInfo -> t -> a)
-> PackageDescription -> LocalBuildInfo -> t -> Verbosity -> IO a
commonBuildHook runHook pkg lbi hooks verbosity = do
-- 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 = if littleEndian then [ "-DLITTLEENDIAN" ] else [ "-DBIGENDIAN" ]
bi = emptyBuildInfo { cppOptions = args, ccOptions = args }
hbi = (Just bi, [(exeName exe, bi) | exe <- executables pkg])
pkg' = updatePackageDescription hbi pkg
lbi' = lbi { localPkgDescr = pkg' }
return $ runHook simpleUserHooks pkg' lbi' hooks
where
testEndianness :: IO Bool
testEndianness = with (1 :: Word32) $ \p -> do o <- peek $ castPtr p
return $ o == (1 :: Word8)
import Distribution.System
import Distribution.Verbosity
import Distribution.PackageDescription
import Distribution.Simple
import Distribution.Simple.Program
import Distribution.Simple.Setup
import Distribution.Simple.LocalBuildInfo
import Distribution.Simple.Utils
import Distribution.Simple.PackageIndex
import qualified Distribution.InstalledPackageInfo as Installed
import System.IO
import System.Exit
import System.Directory
import Control.Exception.Extensible
import Control.Monad(when)
main :: IO ()
main = defaultMainWithHooks myHooks
myHooks :: UserHooks
myHooks
| buildOS == Windows = simpleUserHooks
| otherwise = simpleUserHooks {
confHook = \genericDescript flags -> do
warnIfNotTerminfo flags
lbi <- confHook simpleUserHooks genericDescript flags
let pkgDescr = localPkgDescr lbi
let Just lib = library pkgDescr
let bi = libBuildInfo lib
bi' <- maybeSetLibiconv flags bi lbi
return lbi {localPkgDescr = pkgDescr {
library = Just lib {
libBuildInfo = bi'}}}
}
-- Test whether compiling a c program that links against libiconv needs -liconv.
maybeSetLibiconv :: ConfigFlags -> BuildInfo -> LocalBuildInfo -> IO BuildInfo
maybeSetLibiconv flags bi lbi = do
let biWithIconv = addIconv bi
let verb = fromFlag (configVerbosity flags)
if hasFlagSet flags (FlagName "libiconv")
then do
putStrLn "Using -liconv."
return biWithIconv
else do
putStr "checking whether to use -liconv... "
hFlush stdout
worksWithout <- tryCompile iconv_prog bi lbi verb
if worksWithout
then do
putStrLn "not needed."
return bi
else do
worksWith <- tryCompile iconv_prog biWithIconv lbi verb
if worksWith
then do
putStrLn "using -liconv."
return biWithIconv
else error "Unable to link against the iconv library."
hasFlagSet :: ConfigFlags -> FlagName -> Bool
hasFlagSet cflags flag = Just True == lookup flag (configConfigurationsFlags cflags)
tryCompile :: String -> BuildInfo -> LocalBuildInfo -> Verbosity -> IO Bool
tryCompile program bi lbi verb = handle processExit $ handle processException $ do
tempDir <- getTemporaryDirectory
withTempFile tempDir ".c" $ \fname cH ->
withTempFile tempDir "" $ \execName oH -> do
hPutStr cH program
hClose cH
hClose oH
-- TODO take verbosity from the args.
rawSystemProgramStdoutConf verb gccProgram (withPrograms lbi)
(fname : "-o" : execName : args)
return True
where
processException :: IOException -> IO Bool
processException e = return False
processExit = return . (==ExitSuccess)
-- Mimicing Distribution.Simple.Configure
deps = topologicalOrder (installedPkgs lbi)
args = concat
[ ccOptions bi
, cppOptions bi
, ldOptions bi
-- --extra-include-dirs and --extra-lib-dirs are included
-- in the below fields.
-- Also sometimes a dependency like rts points to a nonstandard
-- include/lib directory where iconv can be found.
, map ("-I" ++) (includeDirs bi ++ concatMap Installed.includeDirs deps)
, map ("-L" ++) (extraLibDirs bi ++ concatMap Installed.libraryDirs deps)
, map ("-l" ++) (extraLibs bi)
]
addIconv :: BuildInfo -> BuildInfo
addIconv bi = bi {extraLibs = "iconv" : extraLibs bi}
iconv_prog :: String
iconv_prog = unlines $
[ "#include "
, "int main(void) {"
, " iconv_t t = iconv_open(\"UTF-8\", \"UTF-8\");"
, " return 0;"
, "}"
]
warnIfNotTerminfo flags = when (not (hasFlagSet flags (FlagName "terminfo"))) $
putStrLn $
"*** Warning: running on POSIX but not building the terminfo backend. ***"
import Distribution.Simple
import System.Process (rawSystem)
import System.Exit (ExitCode(..))
import System.FilePath (())
main = defaultMainWithHooks $ simpleUserHooks { runTests = \args _ _ _ -> do
ExitSuccess <- rawSystem "runhaskell" (("Test" "Runner.hs") : args)
return ()
}
#!/usr/bin/env runhaskell
\begin{code}
import Distribution.Simple
import Distribution.PackageDescription
import Distribution.Version
import Distribution.Simple.LocalBuildInfo
import Distribution.Simple.Program
import Distribution.Verbosity
import Data.Char (isSpace)
import Data.List (dropWhile,span)
import Control.Monad
main = defaultMainWithHooks simpleUserHooks {
hookedPrograms = [mysqlConfigProgram],
confHook = \pkg flags -> do
lbi <- confHook simpleUserHooks pkg flags
bi <- mysqlBuildInfo lbi
return lbi {
localPkgDescr = updatePackageDescription
(Just bi, []) (localPkgDescr lbi)
}
}
mysqlConfigProgram = (simpleProgram "mysql_config") {
programFindLocation = \verbosity -> do
mysql_config <- findProgramOnPath "mysql_config" verbosity
mysql_config5 <- findProgramOnPath "mysql_config5" verbosity
return (mysql_config `mplus` mysql_config5)
}
mysqlBuildInfo :: LocalBuildInfo -> IO BuildInfo
mysqlBuildInfo lbi = do
(mysqlConfigProg, _) <- requireProgram verbosity
mysqlConfigProgram AnyVersion (withPrograms lbi)
let mysqlConfig = rawSystemProgramStdout verbosity mysqlConfigProg
ws = " \n\r\t"
includeDirs <- return . map (drop 2) . split ws =<< mysqlConfig ["--include"]
ldOptions <- return . split ws =<< mysqlConfig ["--libs"]
return emptyBuildInfo {
ldOptions = ldOptions,
includeDirs = includeDirs
}
where
verbosity = normal -- honestly, this is a hack
split :: Eq a => [a] -> [a] -> [[a]]
split xs cs = split' $ dropWhile (`elem` xs) cs
where split' [] = []
split' cs0 =
let (run, cs1) = span (`notElem` xs) cs0
cs2 = dropWhile (`elem` xs) cs1
in run:(split' cs2)
\end{code}
#!/usr/bin/env runhaskell
import Distribution.Simple
import Distribution.PackageDescription
import Distribution.Version
import Distribution.Simple.LocalBuildInfo
import Distribution.Simple.Program
import Distribution.Verbosity
import Data.Char (isSpace)
import Data.List (dropWhile,reverse)
import Control.Monad
main = defaultMainWithHooks simpleUserHooks {
hookedPrograms = [pgconfigProgram],
confHook = \pkg flags -> do
lbi <- confHook defaultUserHooks pkg flags
bi <- psqlBuildInfo lbi
return lbi {
localPkgDescr = updatePackageDescription
(Just bi, [("runtests", bi)]) (localPkgDescr lbi)
}
}
pgconfigProgram = (simpleProgram "pgconfig") {
programFindLocation = \verbosity -> do
pgconfig <- findProgramOnPath "pgconfig" verbosity
pg_config <- findProgramOnPath "pg_config" verbosity
return (pgconfig `mplus` pg_config)
}
psqlBuildInfo :: LocalBuildInfo -> IO BuildInfo
psqlBuildInfo lbi = do
(pgconfigProg, _) <- requireProgram verbosity
pgconfigProgram AnyVersion (withPrograms lbi)
let pgconfig = rawSystemProgramStdout verbosity pgconfigProg
incDir <- pgconfig ["--includedir"]
libDir <- pgconfig ["--libdir"]
return emptyBuildInfo {
extraLibDirs = [strip libDir],
includeDirs = [strip incDir]
}
where
verbosity = normal -- honestly, this is a hack
strip x = dropWhile isSpace $ reverse $ dropWhile isSpace $ reverse x
{-# LANGUAGE CPP #-}
import Control.Monad (foldM_, forM_)
import System.Cmd
import System.Exit
import System.Info (os)
import System.FilePath
import System.Directory ( doesFileExist, copyFile, removeFile, createDirectoryIfMissing )
import Distribution.PackageDescription
import Distribution.Simple.Setup
import Distribution.Simple
import Distribution.Simple.LocalBuildInfo
main :: IO ()
main = do
putStrLn $ "Setting up hpage for " ++ os
defaultMainWithHooks $ addMacHook simpleUserHooks
where
addMacHook h =
case os of
"darwin" -> h { postInst = appBundleHook,
runTests = hPageTestRunner }
_ -> h { runTests = hPageTestRunner }
appBundleHook :: Args -> InstallFlags -> PackageDescription -> LocalBuildInfo -> IO ()
appBundleHook _ _ pkg localb =
forM_ exes $ \app ->
do createAppBundle theBindir (buildDir localb app app)
removeFile (theBindir app)
createAppBundleWrapper theBindir app
return ()
where
theBindir = bindir $ absoluteInstallDirs pkg localb NoCopyDest
exes = map exeName $ executables pkg
-- ----------------------------------------------------------------------
-- helper code for application bundles
-- ----------------------------------------------------------------------
-- | 'createAppBundle' @d p@ - creates an application bundle in @d@
-- for program @p@, assuming that @d@ already exists and is a directory.
-- Note that only the filename part of @p@ is used.
createAppBundle :: FilePath -> FilePath -> IO ()
createAppBundle dir p =
do createDirectoryIfMissing False $ bundle
createDirectoryIfMissing True $ bundleBin
createDirectoryIfMissing True $ bundleRsrc
copyFile p (bundleBin takeFileName p)
where
bundle = appBundlePath dir p
bundleBin = bundle "Contents/MacOS"
bundleRsrc = bundle "Contents/Resources"
-- | 'createAppBundleWrapper' @d p@ - creates a script in @d@ that calls
-- @p@ from the application bundle @d takeFileName p <.> "app"@
createAppBundleWrapper :: FilePath -> FilePath -> IO ExitCode
createAppBundleWrapper bindir p =
do writeFile scriptFile scriptTxt
makeExecutable scriptFile
where
scriptFile = bindir takeFileName p
scriptTxt = "`dirname $0`" appBundlePath "." p "Contents/MacOS" takeFileName p ++ " \"$@\""
appBundlePath :: FilePath -> FilePath -> FilePath
appBundlePath dir p = dir takeFileName p <.> "app"
-- ----------------------------------------------------------------------
-- utilities
-- ----------------------------------------------------------------------
makeExecutable :: FilePath -> IO ExitCode
makeExecutable f = system $ "chmod a+x " ++ f
hPageTestRunner :: Args -> Bool -> PackageDescription -> LocalBuildInfo -> IO ()
hPageTestRunner _ _ _ _ = system "cd src && runhaskell HPage/Test/Server.hs" >> return ()module Main(main) where
import Distribution.Simple
import Distribution.Simple.Setup
import Distribution.Simple.LocalBuildInfo
import Distribution.PackageDescription
import System.FilePath
import System.Directory
import System.Cmd ( rawSystem )
import System.Exit
main :: IO ()
main = defaultMainWithHooks
-- simpleUserHooks{copyHook=gacInstall}
simpleUserHooks{postInst=gacInstall}
assembly :: String
assembly = "bridge\\HsDotnetBridge.dll"
gacInstall :: Args
-> InstallFlags
-> PackageDescription
-> LocalBuildInfo
-> IO ()
gacInstall args iflags pd lbi = do
dir <- getCurrentDirectory
putStrLn "Registering hs-dotnet Assembly.."
ex <- rawSystem (dir "gacInstaller.exe") [dir assembly]
case ex of
ExitSuccess{} -> putStrLn "OK!"
ExitFailure{} -> putStrLn ("Unable to register assembly...; try doing it manually via 'gacutil /i'..")
putStrLn "Registering Assembly COM Interop classes.."
ex <- rawSystem (dir "regasm.exe") [dir assembly]
case ex of
ExitSuccess{} -> putStrLn "OK!"
ExitFailure{} -> putStrLn ("Unable to register assembly...; try doing it manually via 'regasm'..")
{-
gacInstall :: PackageDescription
-> LocalBuildInfo
-> UserHooks
-> CopyFlags
-> IO ()
gacInstall pd lbi uHooks cFlags = do
createDirectoryIfMissing prefix
where
rv = releaseVersion pd
verbo = fromFlagOrDefault normal (copyVerbosity flags)
prefix = getPrefix lbi
destdir =
case copyDest cFlags of
Flag (CopyTo f) -> f dropDrive prefix
Flag (CopyPrefix f) -> f
Flag NoCopyDest -> prefix
NoFlag -> prefix
-}
#!/usr/bin/env runghc > import Distribution.Simple > import System.Cmd (rawSystem) > > main :: IO () > main = writeBuildInfo >> defaultMainWithHooks defaultUserHooks > where > writeBuildInfo = rawSystem "perl" ["Configure.PL"]
#!/usr/bin/runghc
\begin{code}
import Distribution.Simple(defaultMainWithHooks ,simpleUserHooks ,preConf)
import Distribution.Simple.Setup(ConfigFlags)
import Distribution.PackageDescription.Parse(writeHookedBuildInfo)
import Distribution.PackageDescription
(HookedBuildInfo ,BuildInfo(extraLibs ,ccOptions) ,emptyBuildInfo)
import System.Info(os)
main = defaultMainWithHooks simpleUserHooks{ preConf=configure }
where
configure:: [String]-> ConfigFlags-> IO HookedBuildInfo
configure args flags = do
let binfo | os == "mingw32" =
emptyBuildInfo{ extraLibs=["odbc32"]
, ccOptions=["-Dmingw32_HOST_OS"] }
| otherwise = emptyBuildInfo{ extraLibs=["odbc"] }
hbi = (Just binfo ,[])
writeHookedBuildInfo "ODBC.buildinfo" hbi
return hbi
\end{code}
#!/usr/bin/runghc
\begin{code}
import Data.Maybe(fromMaybe)
import Distribution.PackageDescription(HookedBuildInfo,emptyHookedBuildInfo
,PackageDescription,emptyBuildInfo
,BuildInfo(extraLibDirs,includeDirs))
import Distribution.PackageDescription.Parse(writeHookedBuildInfo)
import Distribution.Simple(defaultMainWithHooks,autoconfUserHooks
,preConf,postConf)
import Distribution.Simple.LocalBuildInfo
import Distribution.Simple.Setup(ConfigFlags(configVerbosity),Flag(Flag))
import Distribution.Verbosity(Verbosity,silent)
import System.Exit(ExitCode(ExitSuccess),exitWith)
import System.Directory(removeFile,findExecutable,doesDirectoryExist)
import System.Process(runInteractiveProcess, waitForProcess)
import System.IO(hClose, hGetContents, hPutStr, stderr)
import Control.Monad(when)
import Control.OldException(try)
main = defaultMainWithHooks autoconfUserHooks{preConf= preConf
,postConf= postConf}
where
preConf :: [String] -> ConfigFlags -> IO HookedBuildInfo
preConf args flags = do
try (removeFile "PostgreSQL.buildinfo")
return emptyHookedBuildInfo
postConf :: [String] -> ConfigFlags -> PackageDescription -> LocalBuildInfo -> IO ()
postConf args flags _ localbuildinfo = do
mb_bi <- pqConfigBuildInfo (configVerbosity flags)
writeHookedBuildInfo "PostgreSQL.buildinfo" (Just (fromMaybe emptyBuildInfo mb_bi),[])
\end{code}
The following code is derived from Distribution.Simple.Configure
\begin{code}
findProgram
:: String -- ^ program name
-> Maybe FilePath -- ^ optional explicit path
-> IO (Maybe FilePath)
findProgram name Nothing = do
mb_path <- findExecutable name
case mb_path of
Nothing -> message ("No " ++ name ++ " found")
Just path -> message ("Using " ++ name ++ ": " ++ path)
return mb_path
findProgram name (Just path) = do
message ("Using " ++ name ++ ": " ++ path)
return (Just path)
rawSystemGrabOutput :: (Flag Verbosity) -> FilePath -> [String] -> IO String
rawSystemGrabOutput verbosity path args = do
when (verbosity /= Flag silent) $
putStrLn (path ++ concatMap (' ':) args)
(inp,out,err,pid) <- runInteractiveProcess path args Nothing Nothing
exitCode <- waitForProcess pid
if exitCode /= ExitSuccess
then do errMsg <- hGetContents err
hPutStr stderr errMsg
exitWith exitCode
else return ()
hClose inp
hClose err
hGetContents out
message :: String -> IO ()
message s = putStrLn $ "configure: " ++ s
\end{code}
Populate BuildInfo using pkg-config tool.
\begin{code}
pqConfigBuildInfo:: (Flag Verbosity)-> IO (Maybe BuildInfo)
pqConfigBuildInfo verbosity = do
mb_pq_config_path <- findProgram "pg_config" Nothing
case mb_pq_config_path of
Just pq_config_path -> do
message ("configuring pq library")
res <- rawSystemGrabOutput verbosity pq_config_path ["--libdir"]
let lib_dirs= words res
res <- rawSystemGrabOutput verbosity pq_config_path ["--includedir"]
let inc_dirs= words res
res <- rawSystemGrabOutput verbosity pq_config_path ["--includedir-server"]
let inc_dirs_server'= words res
inc_dirs_server <-onlyExistingDirsOf inc_dirs_server'
let bi= emptyBuildInfo{extraLibDirs= lib_dirs
,includeDirs= inc_dirs++inc_dirs_server}
return (Just bi)
Nothing -> do
message ("The package will be built using default settings for pq library")
return Nothing
onlyExistingDirsOf:: [FilePath]-> IO [FilePath]
onlyExistingDirsOf [] = return []
onlyExistingDirsOf (dirPath:restPaths') = do
restPaths <-onlyExistingDirsOf restPaths'
exists <-doesDirectoryExist dirPath
if exists then return (dirPath:restPaths)
else do message ("missing directory: "++dirPath)
return restPaths
\end{code}
#!/usr/bin/runghc
\begin{code}
import Control.Monad(when)
import Control.OldException(try)
import System.Directory(removeFile,findExecutable)
import System.Exit(ExitCode(ExitSuccess) ,exitWith)
import System.IO(hClose, hGetContents, hPutStr, stderr)
import System.Process(runInteractiveProcess, waitForProcess)
import Distribution.PackageDescription
(PackageDescription ,HookedBuildInfo ,emptyHookedBuildInfo
,BuildInfo(extraLibs ,extraLibDirs ,ldOptions ,includeDirs ,ccOptions)
,emptyBuildInfo)
import Distribution.PackageDescription.Parse(writeHookedBuildInfo)
import Distribution.Simple(UserHooks(preConf,postConf) ,simpleUserHooks
,defaultMainWithHooks)
import Distribution.Simple.LocalBuildInfo(LocalBuildInfo)
import Distribution.Simple.Setup(ConfigFlags(configVerbosity),Flag)
import Distribution.Verbosity(Verbosity)
main:: IO ()
main = defaultMainWithHooks simpleUserHooks{ preConf=preConf
, postConf=postConf}
where
preConf:: [String] -> ConfigFlags -> IO HookedBuildInfo
preConf args flags = do
try (removeFile "SQLite3.buildinfo")
return emptyHookedBuildInfo
postConf:: [String] -> ConfigFlags -> PackageDescription -> LocalBuildInfo
-> IO ()
postConf args flags _ localbuildinfo = do
mb_bi <- pkgConfigBuildInfo (configVerbosity flags) "sqlite3"
let bi = case mb_bi of
Just bi -> bi
Nothing -> emptyBuildInfo{ extraLibs=["sqlite3"] }
writeHookedBuildInfo "SQLite3.buildinfo" (Just bi,[])
\end{code}
The following code is derived from Distribution.Simple.Configure
\begin{code}
findProgram:: String -- ^ program name
-> Maybe FilePath -- ^ optional explicit path
-> IO (Maybe FilePath)
findProgram name Nothing = do
mb_path <- findExecutable name
case mb_path of
Nothing -> message ("No " ++ name ++ " found")
Just path -> message ("Using " ++ name ++ ": " ++ path)
return mb_path
findProgram name (Just path) = do
message ("Using " ++ name ++ ": " ++ path)
return (Just path)
-- |
rawSystemGrabOutput:: Int -> FilePath -> [String] -> IO String
rawSystemGrabOutput verbose path args = do
when (verbose > 0) $
putStrLn (path ++ concatMap (' ':) args)
(inp,out,err,pid) <- runInteractiveProcess path args Nothing Nothing
exitCode <- waitForProcess pid
if exitCode /= ExitSuccess
then do errMsg <- hGetContents err
hPutStr stderr errMsg
exitWith exitCode
else return ()
hClose inp
hClose err
hGetContents out
-- |
message:: String -> IO ()
message s = putStrLn $ "configure: " ++ s
\end{code}
Populate BuildInfo using pkg-config tool.
\begin{code}
pkgConfigBuildInfo:: Flag Verbosity -> String -> IO (Maybe BuildInfo)
pkgConfigBuildInfo verbosity pkgName = do
let verbose= -1
mb_pkg_config_path <- findProgram "pkg-config" Nothing
case mb_pkg_config_path of
Just pkg_config_path -> do
message ("configuring "++pkgName++" package using pkg-config")
res <- rawSystemGrabOutput verbose pkg_config_path
[pkgName, "--libs-only-l"]
let libs = map (tail.tail) (words res)
res <- rawSystemGrabOutput verbose pkg_config_path
[pkgName, "--libs-only-L"]
let lib_dirs = map (tail.tail) (words res)
res <- rawSystemGrabOutput verbose pkg_config_path
[pkgName, "--libs-only-other"]
let ld_opts = words res
res <- rawSystemGrabOutput verbose pkg_config_path
[pkgName, "--cflags-only-I"]
let inc_dirs = map (tail.tail) (words res)
res <- rawSystemGrabOutput verbose pkg_config_path
[pkgName, "--cflags-only-other"]
let cc_opts = words res
let bi = emptyBuildInfo{ extraLibs=libs
, extraLibDirs=lib_dirs
, ldOptions=ld_opts
, includeDirs=inc_dirs
, ccOptions=cc_opts}
return (Just bi)
Nothing -> do
message ("The package will be built using default settings for "++pkgName)
return Nothing
\end{code}
{-# LANGUAGE NamedFieldPuns #-}
import Distribution.Simple
import Distribution.Simple.Setup
import Distribution.Simple.LocalBuildInfo
import Distribution.Simple.Utils
import Distribution.PackageDescription
import Distribution.Verbosity
import System.Directory
main = defaultMainWithHooks hooks
hooks = simpleUserHooks
{
preConf = \arg flags -> do
-- probably a nicer way of getting that directory...
createDirectoryIfMissing True "dist/build/autogen"
writeFile "dist/build/autogen/Includes.hs" ("module Includes where\nextraIncludeDirs=" ++ show (configExtraIncludeDirs flags))
return emptyHookedBuildInfo
}#!/usr/bin/env runhaskell
module Main (main) where
import Data.List (isSuffixOf)
import Distribution.PackageDescription
import Distribution.Simple
import System.FilePath
import System.Process
main :: IO ()
main = defaultMainWithHooks (simpleUserHooks {runTests = _runTests, instHook = _instHook})
where
-- Run all executables with names that end in -tests
_runTests _ _ pd _ = do
let exeNames = ["dist" "build" fp fp | fp <- map exeName (executables pd)]
sequence [_runTest e | e <- exeNames, isSuffixOf "-tests" e]
return ()
_runTest fp = do
ph <- runCommand fp
waitForProcess ph
-- Only install executables that don't end in -tests
_instHook pd lbi uhs ifs = do
let execs = filter (\e -> not $ isSuffixOf "-tests" (exeName e)) (executables pd)
(instHook simpleUserHooks) (pd {executables = execs}) lbi uhs ifs
#!/usr/bin/env runghc
import Distribution.Simple
import qualified Control.Exception as Ex
import System.Directory
import Control.Monad
import System.Info
import System.Exit
import List
b = "infinity"
main = defaultMainWithHooks $ defaultUserHooks {
postBuild = copyInfinity,
postClean = cleanInfinity
}
copyInfinity _ _ _ _ = do
copyFile ("dist/build/infinity/"++b) b
Ex.catch (createDirectory "Log" >> createDirectory "State")
(\_ -> return ())
return ()
cleanInfinity _ _ _ _ = do
Ex.catch (removeFile b)
(\_ -> return ())
clean "."
clean "Plugins"
return ()
where
clean s = do
c <- getDirectoryContents s
forM_ c $ \f -> do
if (".o" `isSuffixOf` f ||
".hi" `isSuffixOf` f ||
"#" `isSuffixOf` f ||
"~" `isSuffixOf` f)
then removeFile $ s++"/"++f
else return ()
import Distribution.Simple
import Distribution.Simple.Utils
import Directory
import Monad
import System
neededHeaders = ["jack/jack.h", "st.h"]
main = do
args <- getArgs
when ((head args) == "configure") (checkHeaders neededHeaders)
defaultMainWithHooks defaultUserHooks
checkHeaders ll = do
mapM checkHeader ll
return ()
includeDirs = ["/usr/local/include", "/usr/include"]
checkHeader name = do
putStr ("Searching for " ++ name ++ "...")
bools <- mapM (\ p -> doesFileExist (p ++ "/" ++ name)) includeDirs
when (not $ or bools) (fail ("ERROR: " ++ name ++ " not found"))
putStrLn "found"
module Main where
import System.FilePath
import System.Directory
import Monad
import Data.List
import Distribution.Simple
import Distribution.Simple.Setup
import Distribution.Simple.Program
import Distribution.Simple.LocalBuildInfo
import Distribution.Simple.PreProcess
import Distribution.PackageDescription
import Distribution.Verbosity
import Distribution.ModuleName hiding (main)
import Curry.Files.CymakePath
import Curry.Files.KiCSPath
import Curry.Files.ProphecyPath
withLibs :: Bool
withLibs = False
kics, cymake, prophecy :: IO Program
kics = mkProg getKiCS
cymake = mkProg getCymake
prophecy = mkProg getProphecy
mkProg getProg = do
call <- getProg
return (simpleProgram (takeBaseName call))
{programFindLocation = \_-> return (Just call)}
mkstrict :: Program
mkstrict = simpleProgram "mkstrict"
main :: IO ()
main = do
cymakeProg <- cymake
kicsProg <- kics
prophecyProg <- prophecy
defaultMainWithHooks simpleUserHooks
{hookedPrograms=mkstrict:kicsProg:cymakeProg:prophecyProg:
hookedPrograms simpleUserHooks
,confHook=myConfHook
,postConf=myPostConf
,hookedPreProcessors=[("curry",mkModule),
("lcurry",mkModule),
("fcy",mkOracleModule)]
}
-- what a hack! something was forgotten in Distribution.ModuleName
modName :: [String] -> ModuleName
modName xs = read $ "ModuleName " ++ show xs
myConfHook ::
(Either GenericPackageDescription PackageDescription, HookedBuildInfo)
-> ConfigFlags -> IO LocalBuildInfo
myConfHook info flags = do
lbi <- confHook simpleUserHooks info flags
if not withLibs
then return lbi
else do
print 13
libPath <- getKiCSLibDir
allFiles <- getDirectoryContents libPath
let stdfiles = filter (isSuffixOf ".fcy") allFiles
goodfiles = filter (not . (`elem` badlibs) . takeBaseName) stdfiles
stdlibs = map takeBaseName stdfiles
goodlibs = map takeBaseName goodfiles
libs = map (\ l -> modName ("Curry":"Module":["Oracle" ++ l])) stdlibs
++map (\ l -> modName ("Curry":"DebugModule":[l])) goodlibs
let dbgPath = "Curry" "DebugModule"
mapM_ (putStrLn . (" "++) . foldr (<.>) "" . components) libs
mapM_ (\ lib -> mayCopyFile (libPath lib) (dbgPath lib)) goodfiles
let require = requireProg flags lbi
prop <- require prophecy
mapM_ (mkOracleLib (unflag $ configVerbosity flags) prop) stdlibs
dataPath <- getKiCSDataDir
let package = localPkgDescr lbi
Just lib = library package
ex = exposedModules lib
llbi = libBuildInfo lib
hsdirs = hsSourceDirs llbi
llbi' = llbi{hsSourceDirs=dataPath:hsdirs}
lib' = Just lib{exposedModules=ex ++ libs,
libBuildInfo=llbi'}
return (lbi{localPkgDescr=package{library=lib'}})
mayCopyFile :: FilePath -> FilePath -> IO ()
mayCopyFile src dest = do
ex <- doesFileExist dest
if ex then return () else copyFile src dest
unflag = fromFlagOrDefault silent
requireProg :: ConfigFlags -> LocalBuildInfo -> IO Program
-> IO ConfiguredProgram
requireProg verb lbi prog = do
p <- prog
(cp,_) <- requireProgram (unflag $ configVerbosity verb) p AnyVersion
(withPrograms lbi)
return cp
callProg :: Verbosity -> LocalBuildInfo -> IO Program -> Args -> IO ()
callProg verb lbi prog args = do
p <- prog
rawSystemProgramConf verb p (withPrograms lbi) args
mkOracleLib :: Verbosity -> ConfiguredProgram -> FilePath -> IO ()
mkOracleLib verb prop stdlib = do
rawSystemProgram verb prop ["-o","Curry/Module/",stdlib]
return ()
myPostConf ::
Args -> ConfigFlags -> PackageDescription -> LocalBuildInfo -> IO ()
myPostConf args confFlags descrs lbi = do
let require = requireProg confFlags lbi
require cymake
require kics
require prophecy
postConf simpleUserHooks args confFlags descrs lbi
badlibs =
[
-- mkstrict fails
"Traversal"
,"FlatCurry"
,"AbstractCurry"
,"SetRBT"
,"TableRBT"
,"Pretty"
,"CurryStringClassifier"
,"FiniteMap"
,"Parser"
,"EventOracle"
,"CurrySyntax"
,"EasyCheck"
-- consequence of FlatCurry failing
,"FlexRigid","FlatCurryTools","FlatCurryShow","FlatCurryRead"
,"FlatCurryXML","PrettyFlat","CompactFlatCurry","FlatCurryGoodies"
-- consequence of FiniteMap failing
,"GraphInductive"
-- consequence of AbstractCurry failing
,"AbstractCurryPrinter"
-- consequence of Pretty failing
,"StyledText"
-- resulting haskell incorrect
,"RedBlackTree"
,"IO"
,"Global"
,"Array"
,"Meta"
-- consequence of incorrect IO
, "Assertion"
, "Oracle"
, "Distribution"
, "CEventOracle"
, "IOExts"
, "PropertyFile"
, "Socket"
-- consequence of incorrect Meta
, "Unsafe"
-- consequence of incorrect Global
, "System"
, "Random"
]
mkModule :: BuildInfo -> LocalBuildInfo -> PreProcessor
mkModule _ lbi = PreProcessor
{platformIndependent = True
,runPreProcessor = mkSimplePreProcessor $ \ inf outf verb -> do
datadir <- getKiCSLibDir
runKics datadir lbi inf outf verb}
runKics :: FilePath -> LocalBuildInfo
-> FilePath -> FilePath -> Verbosity -> IO ()
runKics datadir lbi infile outfile verb
| isPrefixOf "Curry/Module" infile
= do callCymake ["-iCurry/Module","--no-hidden-subdir"]
callKics ["-userlibpath","Curry/Module"]
| isPrefixOf "prophecy" infile
= do callCymake ["-iprophecy/Curry/Module"]
callKics $ ["-userlibpath","prophecy/Curry/Module"] ++
if isSuffixOf "Transform.curry" infile
then ["-executable","prophecy"]
else []
| isPrefixOf "biosphere" infile
= do callCymake ["-iprophecy/Curry/Module","-ibiosphere/src/Curry/Module"]
callKics $ ["-userlibpath",
"prophecy/Curry/Module:biosphere/src/Curry/Module"] ++
if isSuffixOf "TransformationDependencies.lcurry" infile
then ["-executable","mkstrict"]
else []
| otherwise = error $ "runKics, unexpected infile: " ++ infile
where
call = callProg verb lbi
callCymake args =
call cymake $ args ++ ["-i"++datadir,"-e","--flat",infile]
callKics args =
call kics $ args ++ ["-nomake","-o",outfile,infile]
mkOracleModule :: BuildInfo -> LocalBuildInfo -> PreProcessor
mkOracleModule buildInfo lbi = PreProcessor
{platformIndependent = True
,runPreProcessor = mkSimplePreProcessor (runKicsFcy lbi)}
runKicsFcy :: LocalBuildInfo -> FilePath -> FilePath -> Verbosity -> IO ()
runKicsFcy lbi infile outfile verb
| isPrefixOf "Curry/Module" infile
= do
libPath <- getOracleLibBaseDir
callKics ["-userlibpath",libPath ++ pathSeparator:"Curry/Module"]
| isPrefixOf "Curry/DebugModule" infile
= do
let dir = addTrailingPathSeparator $
joinPath $
reverse $ drop 2 $ reverse $
splitDirectories (takeDirectory outfile)
call (return mkstrict) ["-o",dir,dropExtension infile]
where
call = callProg verb lbi
callKics args =
call kics $ args ++ ["-nomake","--no-interfaces","-o",outfile,infile]
module Main where
import System.FilePath
import System.Directory
import Monad
import Data.List
import Distribution.Simple
import Distribution.Simple.Setup
import Distribution.Simple.Program
import Distribution.Simple.LocalBuildInfo
import Distribution.Simple.PreProcess
import Distribution.PackageDescription
import Distribution.Verbosity
import Distribution.ModuleName (ModuleName(..))
import Curry.Files.CymakePath
import Curry.Files.KiCSPath
kics, cymake :: IO Program
kics = mkProg getKiCS
cymake = mkProg getCymake
mkProg getProg = do
call <- getProg
return (simpleProgram (takeBaseName call))
{programFindLocation = \_-> return (Just call)}
prophecy, mkstrict :: Program
prophecy = simpleProgram "prophecy"
mkstrict = simpleProgram "mkstrict"
main :: IO ()
main = do
cymakeProg <- cymake
kicsProg <- kics
defaultMainWithHooks simpleUserHooks
{hookedPrograms=kicsProg:cymakeProg:hookedPrograms simpleUserHooks
,postConf=myPostConf
,hookedPreProcessors=[("curry",mkModule)]
}
unflag = fromFlagOrDefault silent
requireProg :: ConfigFlags -> LocalBuildInfo -> IO Program
-> IO ConfiguredProgram
requireProg verb lbi prog = do
p <- prog
(cp,_) <- requireProgram (unflag $ configVerbosity verb) p AnyVersion
(withPrograms lbi)
return cp
callProg :: Verbosity -> LocalBuildInfo -> IO Program -> Args -> IO ()
callProg verb lbi prog args = do
p <- prog
rawSystemProgramConf verb p (withPrograms lbi) args
myPostConf ::
Args -> ConfigFlags -> PackageDescription -> LocalBuildInfo -> IO ()
myPostConf args confFlags descrs lbi = do
let require = requireProg confFlags lbi
require cymake
require kics
postConf simpleUserHooks args confFlags descrs lbi
mkModule :: BuildInfo -> LocalBuildInfo -> PreProcessor
mkModule _ lbi = PreProcessor
{platformIndependent = True
,runPreProcessor = mkSimplePreProcessor $ \ inf outf verb -> do
datadir <- getKiCSLibDir
runKics datadir lbi inf outf verb}
runKics :: FilePath -> LocalBuildInfo
-> FilePath -> FilePath -> Verbosity -> IO ()
runKics datadir lbi infile outfile verb
= do call cymake ["-iCurry/Module","-i"++datadir,
"--no-hidden-subdir",
"-e","--flat",infile]
callKics $ ["-userlibpath","Curry/Module"] ++
if isSuffixOf "Transform.curry" infile
then ["-executable","prophecy"]
else []
where
call = callProg verb lbi
callKics args =
call kics $ args ++ ["-nomake","-o",outfile,infile]
module Main where
import System.FilePath
import Distribution.Simple
import Distribution.Simple.Setup as SS
import Distribution.Simple.Program
import Distribution.Simple.LocalBuildInfo
import Distribution.Simple.PreProcess
import Distribution.PackageDescription
import Distribution.Verbosity
import Curry.Files.CymakePath
kics :: Program
kics = simpleProgram "kics"
cymake :: IO Program
cymake = do
call <- getCymake
return (simpleProgram (takeBaseName call))
{programFindLocation = \_-> return (Just call)}
main :: IO ()
main = do
cymakeProg <- cymake
defaultMainWithHooks simpleUserHooks
{hookedPrograms=kics:cymakeProg:hookedPrograms simpleUserHooks
,postConf=myPostConf
,hookedPreProcessors=[("curry",mkModule)]
}
unflag = fromFlagOrDefault silent
requireProg :: SS.Flag Verbosity -> LocalBuildInfo -> IO Program -> IO ()
requireProg verb lbi prog = do
p <- prog
requireProgram (unflag verb) p AnyVersion (withPrograms lbi)
return ()
callProg :: Verbosity -> LocalBuildInfo -> IO Program -> Args -> IO ()
callProg verb lbi prog args = do
p <- prog
rawSystemProgramConf verb p (withPrograms lbi) args
myPostConf :: Args -> ConfigFlags -> PackageDescription -> LocalBuildInfo -> IO ()
myPostConf args confFlags descrs lbi = do
let require = requireProg (configVerbosity confFlags) lbi
require cymake
postConf simpleUserHooks args confFlags descrs lbi
mkModule :: BuildInfo -> LocalBuildInfo -> PreProcessor
mkModule buildInfo lbi = PreProcessor
{platformIndependent = True
,runPreProcessor = mkSimplePreProcessor (runKics lbi)}
runKics :: LocalBuildInfo -> FilePath -> FilePath -> Verbosity -> IO ()
runKics lbi infile outfile verb = do
let call = callProg verb lbi
datadir = takeDirectory infile
-- nomake not supported
mapM (\ format -> call cymake ["--no-hidden-subdir",
"-e",
'-':'-':format,
"-i"++datadir,
infile])
["flat","extended-flat","acy","uacy","parse-only"]
call (return kics) ["-nomake","-o",outfile,infile]
import System.Cmd (system)
import System.Process (readProcess)
import System.FilePath
import Control.Monad (when, unless, liftM)
import System.Directory
import System.Info as SysVer
import Data.Version
import Distribution.Simple
import Distribution.Simple.LocalBuildInfo
import Distribution.PackageDescription
import Distribution.Simple.InstallDirs (CopyDest(..))
import Distribution.Simple.LocalBuildInfo (absoluteInstallDirs, InstallDirs(..))
lhclibdir = "lib"
libsToBuild = map (lhclibdir ) [ "ghc-prim", "integer-native", "base" ]
main = defaultMainWithHooks simpleUserHooks { postInst = myPostInst }
where myPostInst _ _ pkgdesc buildinfo = do
let dirs = absoluteInstallDirs pkgdesc buildinfo NoCopyDest
pkgVer = pkgVersion (package pkgdesc)
lhc = bindir dirs "lhc"
lhcpkg = bindir dirs "lhc-pkg"
lpkgdesc = localPkgDescr buildinfo
exes = executables lpkgdesc
sanity = any (\(Executable s _ _) -> s == "lhc") exes
unless sanity $ fail "No lhc executale found - this probably shouldn't happen"
let lhcexe = head $ filter (\(Executable s _ _) -> s == "lhc") exes
binfo = buildInfo lhcexe
customF = customFieldsBI binfo
-- initial setup
udir' <- getAppUserDataDirectory "lhc"
-- NOTE - THIS MUST BE KEPT IN SYNC WITH
-- lhc-pkg in lhc-pkg/Main.hs!!!
let udir = udir' (SysVer.arch ++ "-" ++ SysVer.os ++ "-" ++ (showVersion pkgVer))
pkgconf = udir "package" <.> "conf"
b <- doesFileExist pkgconf
unless b $ do
putStr "Creating initial package.conf file..."
createDirectoryIfMissing True udir
writeFile (udir "package.conf") "[]\n"
putStrLn "Done"
-- copy over extra-gcc-opts and unlit from
-- ghc's libdir
-- NOTE FIXME: this assumes that the 'ghc' executable
-- points to the same one you compiled LHC against; although,
-- the compile options would probably roughly stay the same anyway
ghcLibdir <- liftM (unwords . words) $ readProcess "ghc" ["--print-libdir"] []
let unlit = ghcLibdir "unlit"
extragccopts = ghcLibdir "extra-gcc-opts"
putStr "Copying unlit and extra-gcc-opts..."
system $ "cp "++unlit++" "++(udir "unlit")
system $ "cp "++extragccopts++" "++(udir "extra-gcc-opts")
putStrLn "Done"
-- build libraries if -fwith-libs is passed
when (withLibs customF) $ do
let confargs = unwords [ "--lhc", "--with-lhc="++lhc, "--with-lhc-pkg="++lhcpkg
, "--prefix="++show (prefix (installDirTemplates buildinfo))
, "--extra-include-dirs="++(ghcLibdir"include") ]
putStrLn "building libraries..."
installLhcPkgs confargs libsToBuild
withLibs = any $ \(x,y) -> x == "x-build-libs" && y == "True"
installLhcPkgs cf = mapM_ (installLhcPkg cf)
installLhcPkg cf n = do
putStrLn $ "\n[installing "++n++" package for lhc]\n"
let x = unwords ["cd",n
,"&&","runghc Setup configure",cf
,"&&","runghc Setup build"
,"&&","runghc Setup copy"
,"&&","runghc Setup register"]
putStrLn $ x
system x
putStrLn "\nDone"
return ()
import Distribution.Simple.Setup (CopyDest(..),ConfigFlags(..),BuildFlags(..),
CopyFlags(..),RegisterFlags(..),InstallFlags(..),
defaultRegisterFlags,fromFlagOrDefault,Flag(..),
defaultCopyFlags)
import Distribution.Simple
import Distribution.Simple.LocalBuildInfo
(LocalBuildInfo(..),absoluteInstallDirs)
import Distribution.Simple.Configure (configCompilerAux)
import Distribution.PackageDescription (PackageDescription(..))
import Distribution.Simple.InstallDirs
(InstallDirs(..))
import Distribution.Simple.Program
(Program(..),ConfiguredProgram(..),ProgramConfiguration(..),
ProgramLocation(..),simpleProgram,lookupProgram,
rawSystemProgramConf)
import Distribution.Simple.Utils
import Distribution.Verbosity
import Data.Char (isSpace, showLitChar)
import Data.List (isSuffixOf,isPrefixOf)
import Data.Maybe (listToMaybe,isJust)
import Data.Version
import Control.Monad (when,unless)
import Text.Regex (matchRegex,matchRegexAll,mkRegex,mkRegexWithOpts,subRegex)
import Text.ParserCombinators.ReadP (readP_to_S)
import System.Exit
import System.IO (hGetContents,hClose,hPutStr,stderr)
import System.IO.Error (try)
import System.Process (runInteractiveProcess,waitForProcess)
import System.Directory
import System.Info (os)
lhs2tex = "lhs2TeX"
minPolytableVersion = [0,8,2]
shortversion = show (numversion `div` 100) ++ "." ++ show (numversion `mod` 100)
version = shortversion ++ if ispre then "pre" ++ show pre else ""
numversion = 114
ispre = False
pre = 2
main = defaultMainWithHooks lhs2texHooks
sep = if isWindows then ";" else ":"
lhs2texBuildInfoFile :: FilePath
lhs2texBuildInfoFile = "." `joinFileName` ".setup-lhs2tex-config"
generatedFiles = ["Version.lhs","lhs2TeX.1",
"doc" `joinFileName` "InteractiveHugs.lhs",
"doc" `joinFileName` "InteractivePre.lhs"]
data Lhs2texBuildInfo =
Lhs2texBuildInfo { installPolyTable :: Maybe String,
rebuildDocumentation :: Bool }
deriving (Show, Read)
lhs2texHooks = simpleUserHooks
{ hookedPrograms = [simpleProgram "hugs",
simpleProgram "kpsewhich",
simpleProgram "pdflatex",
simpleProgram "mktexlsr"],
postConf = lhs2texPostConf,
postBuild = lhs2texPostBuild,
postCopy = lhs2texPostCopy,
postInst = lhs2texPostInst,
regHook = lhs2texRegHook,
cleanHook = lhs2texCleanHook
}
lhs2texPostConf a cf pd lbi =
do let v = fromFlagOrDefault normal (configVerbosity cf)
-- check polytable
(_,b,_) <- runKpseWhichVar "TEXMFLOCAL"
b <- return . stripQuotes . stripNewlines $ b
ex <- return (not . all isSpace $ b) -- or check if directory exists?
b <- if ex then return b
else do (_,b,_) <- (runKpseWhichVar "TEXMFMAIN")
return . stripQuotes . stripNewlines $ b
ex <- return (not . all isSpace $ b) -- or check if directory exists?
i <- if ex then
do (_,p,_) <- runKpseWhich "polytable.sty"
p <- return . stripNewlines $ p
ex <- doesFileExist p
nec <- if ex then do info v $ "Found polytable package at: " ++ p
x <- readFile p
let vp = do vs <- matchRegex (mkRegexWithOpts " v(.*) .polytable. package" True True) x
listToMaybe [ r | v <- vs, (r,"") <- readP_to_S parseVersion v ]
let (sv,nec) = case vp of
Just n -> (showVersion n,versionBranch n < minPolytableVersion)
Nothing -> ("unknown",True)
info v $ "Package polytable version: " ++ sv
return nec
else return True
info v $ "Package polytable installation necessary: " ++ showYesNo nec
when nec $ info v $ "Using texmf tree at: " ++ b
return (if nec then Just b else Nothing)
else
do warn v "No texmf tree found, polytable package cannot be installed"
return Nothing
-- check documentation
ex <- doesFileExist $ "doc" `joinFileName` "Guide2.dontbuild"
r <- if ex then do info v "Documentation will not be rebuilt unless you remove the file \"doc/Guide2.dontbuild\""
return False
else do let mProg = lookupProgram (simpleProgram "pdflatex") (withPrograms lbi)
case mProg of
Nothing -> info v "Documentation cannot be rebuilt without pdflatex" >> return False
Just _ -> return True
unless r $ info v $ "Using pre-built documentation"
writePersistLhs2texBuildConfig (Lhs2texBuildInfo { installPolyTable = i, rebuildDocumentation = r })
mapM_ (\f -> do info v $ "Creating " ++ f
let hugsExists = lookupProgram (simpleProgram "hugs") (withPrograms lbi)
hugs <- case hugsExists of
Nothing -> return ""
Just _ -> fmap fst (getProgram "hugs" (withPrograms lbi))
let lhs2texDir = buildDir lbi `joinFileName` lhs2tex
let lhs2texBin = lhs2texDir `joinFileName` lhs2tex
readFile (f ++ ".in") >>= return .
-- these paths could contain backslashes, so we
-- need to escape them.
replace "@prefix@" (escapeChars $ prefix (absoluteInstallDirs pd lbi NoCopyDest)) .
replace "@stydir@" (escapeChars $ datadir (absoluteInstallDirs pd lbi NoCopyDest)) .
replace "@LHS2TEX@" lhs2texBin .
replace "@HUGS@" hugs .
replace "@VERSION@" version .
replace "@SHORTVERSION@" shortversion .
replace "@NUMVERSION@" (show numversion) .
replace "@PRE@" (show pre) >>= writeFile f)
generatedFiles
where runKpseWhich v = runCommandProgramConf silent "kpsewhich" (withPrograms lbi) [v]
runKpseWhichVar v = runKpseWhich $ "-expand-var='$" ++ v ++ "'"
lhs2texPostBuild a bf@(BuildFlags { buildVerbosity = vf }) pd lbi =
do let v = fromFlagOrDefault normal vf
ebi <- getPersistLhs2texBuildConfig
let lhs2texDir = buildDir lbi `joinFileName` lhs2tex
let lhs2texBin = lhs2texDir `joinFileName` lhs2tex
let lhs2texDocDir = lhs2texDir `joinFileName` "doc"
callLhs2tex v lbi ["--code", "lhs2TeX.sty.lit"] (lhs2texDir `joinFileName` "lhs2TeX.sty")
callLhs2tex v lbi ["--code", "lhs2TeX.fmt.lit"] (lhs2texDir `joinFileName` "lhs2TeX.fmt")
createDirectoryIfMissing True lhs2texDocDir
if rebuildDocumentation ebi then lhs2texBuildDocumentation a bf pd lbi
else copyFileVerbose v ("doc" `joinFileName` "Guide2.pdf") (lhs2texDocDir `joinFileName` "Guide2.pdf")
lhs2texBuildDocumentation a (BuildFlags { buildVerbosity = vf }) pd lbi =
do let v = fromFlagOrDefault normal vf
let lhs2texDir = buildDir lbi `joinFileName` lhs2tex
let lhs2texBin = lhs2texDir `joinFileName` lhs2tex
let lhs2texDocDir = lhs2texDir `joinFileName` "doc"
snippets <- do guide <- readFile $ "doc" `joinFileName` "Guide2.lhs"
let s = matchRegexRepeatedly (mkRegexWithOpts "^.*input\\{(.*)\\}.*$" True True) guide
return s
mapM_ (\s -> do let snippet = "doc" `joinFileName` (s ++ ".lhs")
c <- readFile $ snippet
let inc = maybe ["poly"] id (matchRegex (mkRegexWithOpts "^%include (.*)\\.fmt" True True) c)
-- rewrite the path to ghc/hugs, and to the preprocessor
writeFile (lhs2texDir `joinFileName` snippet)
( -- replace "^%options ghc" "%options ghc" .
-- replace "^%options hugs" "%options hugs" .
-- TODO: replace or replaceEscaped
replace "-pgmF \\.\\./lhs2TeX" ("-pgmF " ++ lhs2texBin ++ " -optF-Pdoc" ++ sep) $ c )
let incToStyle ["verbatim"] = "verb"
incToStyle ["stupid"] = "math"
incToStyle ["tex"] = "poly"
incToStyle ["polytt"] = "poly"
incToStyle ["typewriter"] = "tt"
incToStyle [x] = x
incToStyle [] = "poly"
callLhs2tex v lbi ["--" ++ incToStyle inc , "-Pdoc" ++ sep, lhs2texDir `joinFileName` snippet]
(lhs2texDocDir `joinFileName` s ++ ".tex")
) snippets
callLhs2tex v lbi ["--poly" , "-Pdoc" ++ sep, "doc" `joinFileName` "Guide2.lhs"]
(lhs2texDocDir `joinFileName` "Guide2.tex")
copyFileVerbose v ("polytable" `joinFileName` "polytable.sty") (lhs2texDocDir `joinFileName` "polytable.sty")
copyFileVerbose v ("polytable" `joinFileName` "lazylist.sty") (lhs2texDocDir `joinFileName` "lazylist.sty")
d <- getCurrentDirectory
setCurrentDirectory lhs2texDocDir
-- call pdflatex as long as necessary
let loop = do rawSystemProgramConf v (simpleProgram "pdflatex") (withPrograms lbi) ["Guide2.tex"]
x <- readFile "Guide2.log"
case matchRegex (mkRegexWithOpts "Warning.*Rerun" True True) x of
Just _ -> loop
Nothing -> return ()
loop
setCurrentDirectory d
lhs2texPostCopy a (CopyFlags { copyDest = cdf, copyVerbosity = vf }) pd lbi =
do let v = fromFlagOrDefault normal vf
let cd = fromFlagOrDefault NoCopyDest cdf
ebi <- getPersistLhs2texBuildConfig
let dataPref = datadir (absoluteInstallDirs pd lbi cd)
createDirectoryIfMissing True dataPref
let lhs2texDir = buildDir lbi `joinFileName` lhs2tex
-- lhs2TeX.{fmt,sty}
mapM_ (\f -> copyFileVerbose v (lhs2texDir `joinFileName` f) (dataPref `joinFileName` f))
["lhs2TeX.fmt","lhs2TeX.sty"]
-- lhs2TeX library
fmts <- fmap (filter (".fmt" `isSuffixOf`)) (getDirectoryContents "Library")
mapM_ (\f -> copyFileVerbose v ("Library" `joinFileName` f) (dataPref `joinFileName` f))
fmts
-- documentation difficult due to lack of docdir
let lhs2texDocDir = lhs2texDir `joinFileName` "doc"
let docDir = if isWindows
then dataPref `joinFileName` "Documentation"
else docdir (absoluteInstallDirs pd lbi cd) `joinFileName` "doc"
let manDir = if isWindows
then dataPref `joinFileName` "Documentation"
else datadir (absoluteInstallDirs pd lbi cd) `joinFileName` ".." `joinFileName` "man" `joinFileName` "man1"
createDirectoryIfMissing True docDir
copyFileVerbose v (lhs2texDocDir `joinFileName` "Guide2.pdf") (docDir `joinFileName` "Guide2.pdf")
when (not isWindows) $
do createDirectoryIfMissing True manDir
copyFileVerbose v ("lhs2TeX.1") (manDir `joinFileName` "lhs2TeX.1")
-- polytable
case (installPolyTable ebi) of
Just texmf -> do let texmfDir = texmf
ptDir = texmfDir `joinFileName` "tex" `joinFileName` "latex"
`joinFileName` "polytable"
createDirectoryIfMissing True ptDir
stys <- fmap (filter (".sty" `isSuffixOf`))
(getDirectoryContents "polytable")
mapM_ (\f -> copyFileVerbose v ("polytable" `joinFileName` f)
(ptDir `joinFileName` f))
stys
Nothing -> return ()
lhs2texPostInst a (InstallFlags { installPackageDB = db, installVerbosity = v }) pd lbi =
do lhs2texPostCopy a (defaultCopyFlags { copyDest = Flag NoCopyDest, copyVerbosity = v }) pd lbi
lhs2texRegHook pd lbi Nothing (defaultRegisterFlags { regPackageDB = db, regVerbosity = v })
lhs2texRegHook pd lbi _ (RegisterFlags { regVerbosity = vf }) =
do let v = fromFlagOrDefault normal vf
ebi <- getPersistLhs2texBuildConfig
when (isJust . installPolyTable $ ebi) $
do rawSystemProgramConf v (simpleProgram "mktexlsr") (withPrograms lbi) []
return ()
lhs2texCleanHook pd lbi v pshs =
do cleanHook simpleUserHooks pd lbi v pshs
try $ removeFile lhs2texBuildInfoFile
mapM_ (try . removeFile) generatedFiles
matchRegexRepeatedly re str =
case matchRegexAll re str of
Just (_,_,r,[s]) -> s : matchRegexRepeatedly re r
Nothing -> []
replace re t x = subRegex (mkRegexWithOpts re True True) x (escapeRegex t)
where
-- subRegex requires us to escape backslashes
escapeRegex [] = []
escapeRegex ('\\':xs) = '\\':'\\': escapeRegex xs
escapeRegex (x:xs) = x : escapeRegex xs
escapeChars :: String -> String
escapeChars t = foldr showLitChar [] t
showYesNo :: Bool -> String
showYesNo p | p = "yes"
| otherwise = "no"
stripNewlines :: String -> String
stripNewlines = filter (/='\n')
stripQuotes :: String -> String
stripQuotes ('\'':s@(_:_)) = init s
stripQuotes x = x
callLhs2tex v lbi params outf =
do let lhs2texDir = buildDir lbi `joinFileName` lhs2tex
let lhs2texBin = lhs2texDir `joinFileName` lhs2tex
let args = [ "-P" ++ lhs2texDir ++ sep ]
++ [ "-o" ++ outf ]
++ (if v == deafening then ["-v"] else [])
++ params
(ex,_,err) <- runCommand v lhs2texBin args
hPutStr stderr (unlines . lines $ err)
maybeExit (return ex)
runCommandProgramConf :: Verbosity -- ^ verbosity
-> String -- ^ program name
-> ProgramConfiguration -- ^ lookup up the program here
-> [String] -- ^ args
-> IO (ExitCode,String,String)
runCommandProgramConf v progName programConf extraArgs =
do (prog,args) <- getProgram progName programConf
runCommand v prog (args ++ extraArgs)
getProgram :: String -> ProgramConfiguration -> IO (String, [String])
getProgram progName programConf =
do let mProg = lookupProgram (simpleProgram progName) programConf
case mProg of
Just (ConfiguredProgram { programLocation = UserSpecified p,
programArgs = args }) -> return (p,args)
Just (ConfiguredProgram { programLocation = FoundOnSystem p,
programArgs = args }) -> return (p,args)
_ -> (die (progName ++ " command not found"))
-- | Run a command in a specific environment and return the output and errors.
runCommandInEnv :: Verbosity -- ^ verbosity
-> String -- ^ the command
-> [String] -- ^ args
-> [(String,String)] -- ^ the environment
-> IO (ExitCode,String,String)
runCommandInEnv v cmd args env =
do when (v >= verbose) $ putStrLn (cmd ++ concatMap (' ':) args)
let env' = if null env then Nothing else Just env
(cin,cout,cerr,pid) <- runInteractiveProcess cmd args Nothing env'
hClose cin
out <- hGetContents cout
err <- hGetContents cerr
stringSeq out (hClose cout)
stringSeq err (hClose cerr)
exit <- waitForProcess pid
return (exit,out,err)
-- | Run a command and return the output and errors.
runCommand :: Verbosity -- ^ verbosity
-> String -- ^ the command
-> [String] -- ^ args
-> IO (ExitCode,String,String)
runCommand v cmd args = runCommandInEnv v cmd args []
-- | Completely evaluates a string.
stringSeq :: String -> b -> b
stringSeq [] c = c
stringSeq (x:xs) c = stringSeq xs c
getPersistLhs2texBuildConfig :: IO Lhs2texBuildInfo
getPersistLhs2texBuildConfig = do
e <- doesFileExist lhs2texBuildInfoFile
let dieMsg = "error reading " ++ lhs2texBuildInfoFile ++ "; run \"setup configure\" command?\n"
when (not e) (die dieMsg)
str <- readFile lhs2texBuildInfoFile
case reads str of
[(bi,_)] -> return bi
_ -> die dieMsg
writePersistLhs2texBuildConfig :: Lhs2texBuildInfo -> IO ()
writePersistLhs2texBuildConfig lbi = do
writeFile lhs2texBuildInfoFile (show lbi)
-- HACKS because the Cabal API isn't sufficient:
-- Distribution.Compat.FilePath is supposed to be hidden in future
-- versions, so we need our own version of it:
joinFileName :: String -> String -> FilePath
joinFileName "" fname = fname
joinFileName "." fname = fname
joinFileName dir "" = dir
joinFileName dir fname
| isPathSeparator (last dir) = dir++fname
| otherwise = dir++pathSeparator:fname
where
isPathSeparator :: Char -> Bool
isPathSeparator | isWindows = ( `elem` "/\\" )
| otherwise = ( == '/' )
pathSeparator | isWindows = '\\'
| otherwise = '/'
-- It would be nice if there'd be a predefined way to detect this
isWindows = "mingw" `isPrefixOf` os || "win" `isPrefixOf` os
#!/usr/bin/env runhaskell
\begin{code}
{-# OPTIONS -Wall -cpp #-}
import Control.Monad
import Data.List
import Distribution.PackageDescription
import Distribution.Simple
import Distribution.Simple.LocalBuildInfo
import Distribution.Simple.Utils
import Distribution.Simple.Setup
import System.Cmd
import System.FilePath
import System.Console.GetOpt
import System.Exit
import System.Directory
import Control.Exception
main :: IO ()
main = do
let hooks = simpleUserHooks {
preConf = generateConfigHs
}
defaultMainWithHooks hooks
\end{code}
\begin{code}
data CoreLinkerFlag = TopDir FilePath | PkgConf FilePath
deriving (Eq, Show)
coreLinkerOptions :: [OptDescr CoreLinkerFlag]
coreLinkerOptions =
[Option [] ["topdir"] (ReqArg TopDir "DIRECTORY")
("Directory d that contains the library files for your stage 2 GHC build.\n"
++ "In an inplace build of GHC, this will be inplace_datadir inside your\n"
++ "top-level GHC build tree."),
Option [] ["pkgconf"] (ReqArg PkgConf "FILEPATH")
("Location of the package.conf file pointing to your packages for the GHC\n"
++ "standard libraries that you've built ext-core for. If you built your\n"
++ "External Core libraries under $GHC, this file should live in $GHC/inplace-datadir/package.conf.")]
getDirs :: [CoreLinkerFlag] -> Maybe (FilePath, FilePath)
getDirs args = case findTopDir args of
Just (TopDir f) -> case findPkgConf args of
Just (PkgConf f1) -> Just (f,f1)
_ -> Nothing
_ -> Nothing
findTopDir, findPkgConf :: [CoreLinkerFlag] -> Maybe CoreLinkerFlag
findTopDir = find isTopDir
findPkgConf = find isPkgConf
isTopDir, isPkgConf :: CoreLinkerFlag -> Bool
isTopDir (TopDir _) = True
isTopDir _ = False
isPkgConf (PkgConf _) = True
isPkgConf _ = False
generateConfigHs :: Args -> ConfigFlags -> IO HookedBuildInfo
generateConfigHs _ confFlags = do
let userConfigArgs = configConfigureArgs confFlags
case getOpt Permute coreLinkerOptions userConfigArgs of
(opts,_,_) -> case getDirs opts of
Just (topDir,pkgConf) -> writeConfigHs topDir pkgConf
Nothing -> error "To build the Core linker, you must supply a top-level directory containing your stage 2 GHC build, as well as the location of your packageconf file. For example: --configure-option=--topdir=your_ghc_build/inplace-datadir/ --configure-option=--pkgconf=your_stage1_ghc_build/inplace-datadir/package.conf"
return emptyHookedBuildInfo
writeConfigHs :: FilePath -> FilePath -> IO ()
writeConfigHs topDir pkgConf = writeFile "Config.hs"
("module Config where\nimport System.FilePath\nghcTopDir::FilePath\nghcTopDir =\""
++ topDir ++ "\"\npkgConf::FilePath\npkgConf=\"" ++ pkgConf ++ "\"\n")
type Hook a = PackageDescription -> LocalBuildInfo -> UserHooks -> a -> IO ()
-- Hack: If PrimEnv.hs exists *and* genprimopcode or
-- primops.txt doesn't exist, don't rebuild PrimEnv.hs
build_primitive_sources :: Hook a -> Hook a
build_primitive_sources f pd lbi uhs x
= do when (compilerFlavor (compiler lbi) == GHC) $ do
let genprimopcode = joinPath ["..", "..", "utils",
"genprimopcode", "genprimopcode"]
primops = joinPath ["..", "..", "compiler", "prelude",
"primops.txt"]
primhs = joinPath ["Language", "Core", "PrimEnv.hs"]
primhs_tmp = addExtension primhs "tmp"
primEnvExists <- doesFileExist primhs
genprimopcodeExists <- doesFileExist genprimopcode
primopsExists <- doesFileExist primops
unless (primEnvExists && not genprimopcodeExists && not primopsExists) $ do
maybeExit $ system (genprimopcode ++ " --make-ext-core-source < "
++ primops ++ " > " ++ primhs_tmp)
maybeUpdateFile primhs_tmp primhs
maybeExit $ system ("make -C lib/GHC_ExtCore")
f pd lbi uhs x
-- Replace a file only if the new version is different from the old.
-- This prevents make from doing unnecessary work after we run 'setup makefile'
maybeUpdateFile :: FilePath -> FilePath -> IO ()
maybeUpdateFile source target = do
r <- rawSystem "cmp" ["-s" {-quiet-}, source, target]
case r of
ExitSuccess -> removeFile source
ExitFailure _ -> do
#if __GLASGOW_HASKELL__ >= 610
(try :: IO () -> IO (Either IOException ()))
#else
try
#endif
(removeFile target)
renameFile source target
\end{code}#!/usr/bin/env runhaskell
> {-# LANGUAGE PatternGuards #-}
> import System.Environment
> import System.Info
> import Control.Monad
> import Data.List
> import Distribution.Simple
> import Distribution.Simple.Setup
>
> main = do
> let hooks = if os == "mingw32" then autoconfUserHooks{ postConf = generateBuildInfo }
> else autoconfUserHooks
> defaultMainWithHooks hooks
>
> -- On Windows we can't count on the configure script, so generate the
> -- llvm.buildinfo from a template.
> generateBuildInfo _ conf _ _ = do
> let args = configConfigureArgs conf
> let pref = "--with-llvm-prefix="
> let path = case [ p | arg <- args, Just p <- [stripPrefix pref arg] ] of
> [p] -> p
> _ -> error $ "Use '--configure-option " ++ pref ++ "PATH' to give LLVM installation path"
> info <- readFile "llvm.buildinfo.windows.in"
> writeFile "llvm.buildinfo" $ subst "@llvm_path@" path info
>
> subst from to [] = []
> subst from to xs | Just r <- stripPrefix from xs = to ++ subst from to r
> subst from to (x:xs) = x : subst from to xs
#!/usr/bin/env runhaskell
\begin{code}
import Distribution.Simple
import Distribution.System
import System.IO
import System.Directory
import Data.List
-- Make sure that 'bits' and 'extraLibs' below is correctly defined
-- for your platform. See Distribution.System for the definitions of
-- the relevant architecture/OS enumerations.
-- string representing the word size of your platform
bits = case buildPlatform of
Platform X86_64 _ -> "64"
Platform IA64 _ -> "64"
Platform PPC64 _ -> "64"
_ -> "32"
-- list of extra libraries against which you need to link
extraLibs = intercalate ", " libs
where libs = case buildPlatform of
Platform _ Linux -> ["rt"]
-- If this setting for windows isn't right, let me know.
-- I haven't tried it, bu just guessed what it should be
-- from the definition of the mcc script.
Platform I386 Windows -> ["Gdi32"]
-- For now, nothing extra is specified for other platforms.
-- If you are on another platform and you needed to
-- link against extra libraries, let me know what they
-- are.
_ -> []
buildInfoFileName = "mathlink.buildinfo"
archHeaderFileName = "cbits/arch.h"
buildInfoFile = "\
\Extra-Libraries: ML" ++ bits ++ "i3, " ++ extraLibs ++ "\n"
archHeaderFile = "\
\#ifndef __ARCH_H__\n\
\#define __ARCH_H__\n\
\\n\
\#define IS_" ++ bits ++ "_BIT\n\
\\n\
\#endif\n"
makeFiles _ _ _ _ = do
writeFile buildInfoFileName buildInfoFile
writeFile archHeaderFileName archHeaderFile
main = defaultMainWithHooks autoconfUserHooks {
postConf = makeFiles
}
\end{code}
import Distribution.Simple
import Distribution.Simple.Utils
import Distribution.Simple.Setup
import Distribution.Simple.Program
import Distribution.Simple.LocalBuildInfo
import Distribution.PackageDescription
import Distribution.ModuleName (components)
import Control.Monad
import Data.Maybe
import System.Directory
import System.FilePath
defhooks = autoconfUserHooks
programs = [
simpleProgram "matlab",
(simpleProgram "mcr") { programFindLocation = \_ -> return Nothing }
]
runtime desc = maybe False (elem ["Foreign","Matlab","Runtime"] . map components . exposedModules) $ library desc
postconf args flags desc build = do
confExists <- doesFileExist "configure"
unless confExists $ rawSystemExit verb "autoconf" []
postConf defhooks args flags{ configConfigureArgs = configConfigureArgs flags ++ confargs } desc build
where
verb = fromFlag $ configVerbosity flags
confargs = ("--" ++ (if runtime desc then "enable" else "disable") ++ "-runtime") : map pconfarg pconf
pconfarg p = "--with-" ++ programId p ++ "=" ++ programPath p ++ " " ++ unwords (programArgs p)
pconf = mapMaybe (\p -> lookupProgram p (withPrograms build)) programs
build desc binfo hooks flags = do
when (runtime desc) $ rawSystemExit (fromFlag $ buildVerbosity flags) "make" ["-Csrc"]
buildHook defhooks desc binfo hooks flags
clean desc binfo hooks flags = do
makeExists <- doesFileExist "src/Makefile"
when makeExists $ rawSystemExit (fromFlag $ cleanVerbosity flags) "make" ["-Csrc", "clean"]
cleanHook defhooks desc binfo hooks flags
install desc binfo hooks flags = do
instHook defhooks desc binfo hooks flags
when (runtime desc) $ mapM_ (\f ->
copyFileVerbose (fromFlag $ installVerbosity flags)
("src" f)
(libdir (absoluteInstallDirs desc binfo NoCopyDest) f))
["libhsmatlab.so","libhsmatlab.ctf"]
reg desc binfo hooks flags = do
pwd <- getCurrentDirectory
let
desc' = desc{ library = fmap lm (library desc) }
lm l = l{ libBuildInfo = (libBuildInfo l)
{ ldOptions = ("-Wl,-rpath," ++ lib) : ldOptions (libBuildInfo l) } }
lib
| fromFlag $ regInPlace flags = pwd "src"
| otherwise = libdir (absoluteInstallDirs desc binfo NoCopyDest)
regHook defhooks desc' binfo hooks flags
hooks = defhooks {
hookedPrograms = programs,
postConf = postconf,
buildHook = build,
cleanHook = clean,
instHook = install,
regHook = reg
}
main = defaultMainWithHooks hooks
#!/usr/bin/env runhaskell
import Distribution.PackageDescription
import Distribution.Simple
import Distribution.Simple.LocalBuildInfo
import Distribution.Simple.Program
import Distribution.PackageDescription.Parse (writeHookedBuildInfo)
import qualified Distribution.Verbosity as Verbosity
import Data.List
main = defaultMainWithHooks autoconfUserHooks {
hookedPrograms = [pyConfigProgram],
postConf=configure
}
pyConfigProgram = (simpleProgram "python")
configure _ _ _ lbi = do
mb_bi <- pyConfigBuildInfo Verbosity.normal lbi
writeHookedBuildInfo "MissingPy.buildinfo" (mb_bi,[])
-- Populate BuildInfo using python tool.
pyConfigBuildInfo verbosity lbi = do
(pyConfigProg, _) <- requireProgram verbosity pyConfigProgram
-- (orLaterVersion $ Version [2] []) (withPrograms lbi)
(AnyVersion) (withPrograms lbi)
let python = rawSystemProgramStdout verbosity pyConfigProg
libDir <- python ["-c", "from distutils.sysconfig import *; print get_python_lib()"]
incDir <- python ["-c", "from distutils.sysconfig import *; print get_python_inc()"]
confLibDir <- python ["-c", "from distutils.sysconfig import *; print get_config_var('LIBDIR')"]
libName <- python ["-c", "import sys; print \"python%d.%d\" % (sys.version_info[0], sys.version_info[1])"]
return $ Just emptyBuildInfo {
extraLibDirs = lines confLibDir ++ lines libDir,
includeDirs = lines incDir ++ ["glue"],
extraLibs = lines libName
}