Cabal Setup file examples

Most of the packages in Hackage have trivial Setup.hs or Setup.lhs program files. In creating a list of Setup file examples, I'm filtering out these trivial Setup files, defined as having:

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


1. Substantial custom Setup files

2. Test-only custom Setup files


Substantial custom Setup files


alex-2.3.1

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

astview-0.1.4

#!/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 "%%%")

augeas-0.1.2

#!/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 ()




bindings-0.1.2

#!/usr/bin/env runhaskell

module  Main (main) where  { import  Distribution.Simple ;  main =
defaultMain }

bsd-sysctl-1.0.4

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 ()

cabalmdvrpm-0.0.1

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


cautious-file-0.1.5

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

cedict-0.2.5

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


darcs-benchmark-0.1.3

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")
}

darcs-beta-2.2.98.4

\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}

darcs-2.3.1

\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}

emgm-0.3.1

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


encoding-0.6.2

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)
                                                    )
                             })

epic-0.1.2

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})


esotericbot-0.0.6

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

extcore-0.5

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

fenfire-0.1

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

ForSyDe-3.0

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

franchise-0.0.6

#!/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 ["",
                    ""]

GenI-0.20.2

{-# 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"]

ghc-paths-0.1.0.6

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

hamusic-0.1.2.1

import Distribution.Simple
import System
main = system "DtdToHaskell src/Script.dtd >src/Script.hs">> defaultMain

happraise-0.1

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


happstack-facebook-0.9

#!/usr/bin/env runghc

module Main where

import Distribution.Simple
import Distribution.Simple.Program

trhsxProgram = simpleProgram "trhsx"

main :: IO ()
main = defaultMainWithHooks simpleUserHooks {
         hookedPrograms = [trhsxProgram]
       }

happy-1.18.4

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

hashed-storage-0.4.3

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)

haskeline-0.6.2.2

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. ***"

haskell-src-exts-1.3.4

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 ()
                                              }

HDBC-mysql-0.6

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

HDBC-postgresql-2.2.0.0

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

hpage-0.4.8

{-# 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 ()

hs-dotnet-0.4.0

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
       
   -}

HsPerl5-0.0.6

#!/usr/bin/env runghc
> import Distribution.Simple
> import System.Cmd (rawSystem)
> 
> main :: IO ()
> main = writeBuildInfo >> defaultMainWithHooks defaultUserHooks
>     where
>     writeBuildInfo = rawSystem "perl" ["Configure.PL"]

hsql-odbc-1.7.1

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

hsql-postgresql-1.7.3

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

hsql-sqlite3-1.7.1

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

hubris-0.0.2

{-# 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
  }

HUnit-1.2.2.1

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

infinity-0.3

#!/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 ()

jack-0.5

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"


KiCS-debugger-0.1.1

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]
  



KiCS-prophecy-0.1.1

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]


KiCS-0.9.2

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]




lhc-0.8

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 ()

lhs2tex-1.14

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 

linkcore-0.3

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

llvm-0.7.0.0

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

mathlink-2.0.1.1

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

matlab-0.1

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

MissingPy-0.10.3

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

multiplicity-0.1.0

#! /usr/bin/env runhaskell

-- Copyright: 2009 Dino Morelli
-- License: BSD3 (see LICENSE)
-- Author: Dino Morelli 

import Control.Monad ( unless )
import Distribution.Simple
import System.FilePath
import System.Posix.Files ( createSymbolicLink, fileExist )


main = defaultMainWithHooks (simpleUserHooks 
   { postBuild = customPostBuild
   } )
   where
      -- Create symlink to the binary after build for developer 
      -- convenience
      customPostBuild _ _ _ _ = do
         let dest = "multiplicity"

         exists <- fileExist dest
         unless exists $ do
            let src = "dist"  "build"  dest  dest
            createSymbolicLink src dest

network-fancy-0.1.4

#!/usr/bin/env runhaskell
import Distribution.Simple
import System.Cmd
import System.Directory

main = defaultMainWithHooks simpleUserHooks{ runTests = \_ _ _ _ -> rt }

rt :: IO ()
rt = do system "ghc --make -threaded test.hs -o test"
        system "./test"
        mapM_ removeFile ["test","test.hi","test.o"]
        return ()

the-omega-project

# Makefile for Omega

default:
	@echo This is a minimal version of the Omega library distributed
	@echo as part of the Cabal package "Omega".
	@echo Please run Setup.hs to build.

all: oc petit

BASEDIR =.

libomega.a: always 
	cd omega_lib/obj; $(MAKE) libomega.a

depend: depend_all
clean: clean_all
veryclean: veryclean_all

SUBMAKE=$(MAKE)

include $(BASEDIR)/Makefile.rules

Omega-0.2.1

import Control.Applicative
import Control.Exception(bracket)
import Control.Monad
import Data.Char
import Data.Maybe
import Distribution.PackageDescription
import Distribution.Simple
import Distribution.Simple.BuildPaths
import Distribution.Simple.LocalBuildInfo
import Distribution.Simple.Program
import Distribution.Simple.Setup
import Distribution.Simple.Utils
import qualified Distribution.Verbosity as Verbosity
import System.Cmd
import System.Directory
import System.Exit(ExitCode(..))
import System.IO
import System.FilePath((), (<.>), takeExtension)
import System.Process

-- Mimic the && command of 'sh'
(>&&>) :: IO ExitCode -> IO ExitCode -> IO ExitCode
cmd1 >&&> cmd2 = cmd1 >>= continue
    where 
      continue ExitSuccess = cmd2
      continue returnCode  = return returnCode

-- Record whether we're building the Omega library here
useInstalledOmegaFlagPath = "build"  "UseInstalledOmega"

writeUseInstalledOmegaFlag :: Bool -> IO ()
writeUseInstalledOmegaFlag b = do
  createDirectoryIfMissing False "build"
  writeFile useInstalledOmegaFlagPath (show b)

readUseInstalledOmegaFlag :: IO Bool
readUseInstalledOmegaFlag = do
  text <- readFile useInstalledOmegaFlagPath `catch`
          \_ -> die "Configuration file missing; try reconfiguring"
  return $! read text

-- We will call 'autoconf' and 'make'
autoconfProgram = simpleProgram "autoconf"
makeProgram = simpleProgram "make"

-- Our single C++ source file and corresponding object file are here
cppSourceName = "src"  "C_omega.cc"
cppObjectName = "build"  "C_omega.o"

-- If we're building the Omega library, it's here
omegaLibPath = "src"  "the-omega-project"  "omega_lib"  "obj"  "libomega.a"

-- Unpack the Omega library into this directory
omegaUnpackPath = "build"  "unpack_omega"

noGHCiLib =
    die "Sorry, this package does not support GHCi.\n\
        \Please configure with --disable-library-for-ghci to disable."

noSharedLib =
    die "Sorry, this package does not support shared library output.\n\
        \Please configure with --disable-shared to disable."

-------------------------------------------------------------------------------
-- Configuration

configureOmega pkgDesc flags = do
  -- Run Cabal configure
  lbi <- confHook simpleUserHooks pkgDesc flags

  -- Detect and report error on unsupported configurations
  when (withGHCiLib lbi) noGHCiLib

  when (withSharedLib lbi) noSharedLib

  let verb = fromFlagOrDefault Verbosity.normal $ configVerbosity flags
      cfg = withPrograms lbi
      runAutoconf = do rawSystemProgramConf verb autoconfProgram cfg []
                       return ExitSuccess
      
  -- Run autoconf configure
  runAutoconf >&&> runConfigure lbi

  -- Save this flag for later use
  writeUseInstalledOmegaFlag useInstalledOmega

  return lbi

    where
      -- Will build the Omega library?
      useInstalledOmega = fromMaybe False $
                          lookup (FlagName "useinstalledomega") $
                          configConfigurationsFlags flags

      -- Run 'configure' with the extra arguments that were passed to
      -- Setup.hs
      runConfigure lbi = do
        currentDir <- getCurrentDirectory

        let opts = autoConfigureOptions lbi useInstalledOmega
            configProgramName = currentDir  "configure"

        rawSystem configProgramName opts

-- Configuration: extract options to pass to 'configure'
autoConfigureOptions :: LocalBuildInfo -> Bool -> [String]
autoConfigureOptions localBuildInfo useInstalledOmega =
    withOmega ++ [libdirs, includedirs]
    where
      withOmega = if useInstalledOmega
                  then ["--with-omega"]
                  else []

      libraryDescr = case library $ localPkgDescr localBuildInfo
                     of Nothing -> error "Library description is missing"
                        Just l -> l

      buildinfo = libBuildInfo libraryDescr

      -- Create a string "-L/usr/foo -L/usr/bar"
      ldflagsString =
          intercalate " " ["-L" ++ dir | dir <- extraLibDirs buildinfo]

      libdirs = "LDFLAGS=" ++ ldflagsString

      -- Create a string "-I/usr/foo -I/usr/bar"
      cppflagsString =
          intercalate " " ["-I" ++ dir | dir <- includeDirs buildinfo]

      includedirs = "CPPFLAGS=" ++ cppflagsString

-------------------------------------------------------------------------------
-- Building

buildOmega pkgDesc lbi userhooks flags = do

  useInstalledOmega <- readUseInstalledOmegaFlag

  -- Do default build procedure for hs files
  buildHook simpleUserHooks pkgDesc lbi userhooks flags

  -- Get 'ar' and 'ld' programs
  let verb = fromFlagOrDefault Verbosity.normal $ buildVerbosity flags
  let runAr = rawSystemProgramConf verb arProgram (withPrograms lbi)

  -- Build the C++ source file (and Omega library, if configured)
  -- Makefile's behavior is controlled by output of 'configure'
  rawSystemProgramConf verb makeProgram (withPrograms lbi) ["all"]

  -- Add other object files to libraries
  let pkgId   = package $ localPkgDescr lbi

  let -- Add extra files into an archive file
      addStaticObjectFiles libName = do
          -- Add the C++ interface file
          addStaticObjectFile cppObjectName libName

          -- Add contents of libomega.a
          unless useInstalledOmega $
              transferArFiles verb runAr omegaLibPath libName

          where
            addStaticObjectFile objName libName =
                runAr ["r", libName, objName]

  when (withVanillaLib lbi) $
       let libName = buildDir lbi  mkLibName pkgId
       in addStaticObjectFiles libName

  when (withProfLib lbi) $
       let libName = buildDir lbi  mkProfLibName pkgId
       in addStaticObjectFiles libName

  when (withGHCiLib lbi) noGHCiLib
  when (withSharedLib lbi) noSharedLib

  return ()

-- Transfer the contents of one archive to another
transferArFiles verb runAr src dst = do
  srcCan <- canonicalizePath src
  dstCan <- canonicalizePath dst

  -- Create/remove a temporary directory
  bracket createUnpackDirectory (\_ -> removeUnpackDirectory) $ \_ ->

    -- Save/restore the current working directory
    bracket getCurrentDirectory setCurrentDirectory $ \_ -> do

      -- Go to temporary directory
      setCurrentDirectory omegaUnpackPath

      -- Unpack source archive
      runAr ["x", srcCan]

      -- Find object files
      objs <- liftM (filter isObjectFile) $ getDirectoryContents "."
      when (null objs) $ warn verb "No object files found in Omega library; build may be incomplete"

      -- Insert into destination archive
      runAr (["r", dstCan] ++ objs)
    where
      isObjectFile f = takeExtension f == ".o"

      createUnpackDirectory = createDirectoryIfMissing True omegaUnpackPath
      removeUnpackDirectory = removeDirectoryRecursive omegaUnpackPath

-------------------------------------------------------------------------------
-- Cleaning

cleanOmega pkgDesc mlbi userhooks flags = do
  let verb = fromFlagOrDefault Verbosity.normal $ cleanVerbosity flags

  -- run 'make clean', which will clean the Omega library if appropriate
  pgmConf <- configureProgram verb makeProgram defaultProgramConfiguration
  makeExists <- doesFileExist "Makefile"
  when makeExists $
       rawSystemProgramConf verb makeProgram pgmConf ["clean"]

  -- Clean extra files if we don't need to save configuration
  -- (Other temp files are automatically cleaned)
  unless (fromFlag $ cleanSaveConf flags) $ do
    lenientRemoveFiles configFiles
    lenientRemoveDirectory "autom4te.cache"

  -- Do default clean procedure
  cleanHook simpleUserHooks pkgDesc mlbi userhooks flags

    where
      -- Attempt to remove a file, ignoring errors
      lenientRemoveFile f =
          removeFile f `catch` \_ -> return ()

      lenientRemoveFiles = mapM_ lenientRemoveFile

      -- Attempt to remove a directory and its contents
      -- (one level of recursion only), ignoring errors
      lenientRemoveDirectory f = do
        b <- doesDirectoryExist f
        when b $ do lenientRemoveFiles . map (f ) =<< getDirectoryContents f
                    removeDirectory f `catch` \_ -> return ()

      -- Extra files produced by configuration
      configFiles = ["configure", "config.log", "config.status", "Makefile",
                     useInstalledOmegaFlagPath]

-------------------------------------------------------------------------------
-- Hooks

hooks =
    simpleUserHooks
    { hookedPrograms = [arProgram, autoconfProgram, makeProgram]
    , confHook = configureOmega
    , buildHook = buildOmega
    , cleanHook = cleanOmega
    }

main = defaultMainWithHooks hooks

pandoc-1.2.1

import Distribution.Simple
import Control.Exception ( bracket_ )
import Control.Monad ( unless )
import System.Process ( runCommand, runProcess, waitForProcess )
import System.FilePath ( (), (<.>) )
import System.Directory
import System.IO ( stderr, openTempFile )
import System.Exit
import System.Time
import System.IO.Error ( isDoesNotExistError )
import Data.Maybe ( fromJust, isNothing, catMaybes )
import Data.List ( isInfixOf )

main = do
  defaultMainWithHooks $ simpleUserHooks { runTests  = runTestSuite
                                         , postBuild = makeManPages }
  exitWith ExitSuccess

-- | Run test suite.
runTestSuite _ _ _ _ = do
  tempPath <- catch getTemporaryDirectory (\_ -> return ".")
  (outputPath, hOut) <- openTempFile tempPath "out"
  runProcess "pandoc" ["--version"] Nothing Nothing Nothing (Just hOut) Nothing >>= waitForProcess
  output <- readFile outputPath
  let highlightingSupport = "with syntax highlighting" `isInfixOf` output
  let testArgs = if highlightingSupport then ["lhs"] else []
  let testCmd  = "runhaskell -i.. RunTests.hs " ++ unwords testArgs
  inDirectory "tests" $ runCommand testCmd >>= waitForProcess >>= exitWith

-- | Build man pages from markdown sources in man/man1/.
makeManPages _ _ _ _ = do
  mapM_ makeManPage ["pandoc.1", "hsmarkdown.1", "html2markdown.1", "markdown2pdf.1"]

-- | Build a man page from markdown source in man/man1.
makeManPage manpage = do
  let manDir = "man"  "man1"
  let pandoc = "dist"  "build"  "pandoc"  "pandoc"
  let page = manDir  manpage
  let source = manDir  manpage <.> "md"
  modifiedDeps <- modifiedDependencies page [source]
  unless (null modifiedDeps) $ do
    ec <- runProcess pandoc ["-s", "-S", "-r", "markdown", "-w", "man", "-o", page, source]
                Nothing Nothing Nothing Nothing (Just stderr) >>= waitForProcess
    case ec of
         ExitSuccess -> putStrLn $ "Created " ++ manDir  manpage
         _           -> do putStrLn $ "Error creating " ++ manDir  manpage
                           exitWith ec

-- | Returns a list of 'dependencies' that have been modified after 'file'.
modifiedDependencies :: FilePath -> [FilePath] -> IO [FilePath]
modifiedDependencies file dependencies = do
  fileModTime <- catch (getModificationTime file) $
                 \e -> if isDoesNotExistError e
                          then return (TOD 0 0)   -- the minimum ClockTime
                          else ioError e
  depModTimes <- mapM getModificationTime dependencies
  let modified = zipWith (\dep time -> if time > fileModTime then Just dep else Nothing) dependencies depModTimes
  return $ catMaybes modified

-- | Perform an IO action in a directory.
inDirectory :: FilePath -> IO a -> IO a
inDirectory dir action = do
  oldDir <- getCurrentDirectory
  bracket_ (setCurrentDirectory dir) (setCurrentDirectory oldDir) action


pdf2line-0.0.1

#!/usr/bin/env runhaskell
\begin{code}
import System.Cmd
import Distribution.Simple

main = defaultMainWithHooks $ simpleUserHooks
    { buildHook = myBuild (buildHook simpleUserHooks) }

myBuild doBuild x y z w = do
    rv <- doBuild x y z w
    system "make -f Makefile.pdfdump"
    return rv

\end{code}

Pugs-6.2.13.14

#!/usr/bin/env runghc
> import Distribution.Simple
> import System.Cmd (rawSystem)
> 
> main :: IO ()
> main = writeBuildInfo >> defaultMainWithHooks defaultUserHooks
>     where
>     writeBuildInfo = rawSystem "perl" ["Configure.PL"]

regex-pcre-0.94.1

#!/usr/bin/env runhaskell

-- I usually compile this with "ghc --make -o setup Setup.hs"

import Distribution.Simple(defaultMain)
main = do putStrLn msg
          defaultMain

msg = "\nregex-pcre needs to compile against the libpcre libary from http://www.pcre.org/\n\
      \You might also need to edit the end of the regex-pcre.cabal file to point at\n\
      \the directories where libpcre 'include' and 'lib' have been installed.\n"

regex-posix-0.94.1

#!/usr/bin/env runhaskell

import Distribution.Simple
main = do
  putStrLn msg
  defaultMainWithHooks simpleUserHooks

msg = "This links to the standard c library version of regular expressions.\n\
      \The corresponding c header file is regex.h and there is a chance you\n\
      \will need to edit the end of the regex-posix.cabal file to find the\n\
      \include directory and/or library.\n\
      \Alternatively you can try and use flags to the cabal executable to\n\
      \specify the include and lib directories."

regex-tre-0.91

#!/usr/bin/env runhaskell

-- I usually compile this with "ghc --make -o setup Setup.hs"

import Distribution.Simple(defaultMain)
main = do putStrLn msg
          defaultMain

msg = "regex-tre needs to compile against the libtre libary from http://laurikari.net/tre/\n\
      \You might also need to edit the end of the regex-tre.cabal file to point at\n\
      \the directories where libtre 'include' and 'lib' have been installed.\n"

RSA-1.0.2

import Distribution.PackageDescription
import Distribution.Simple
import Distribution.Simple.LocalBuildInfo
import System.Cmd
import System.FilePath

main :: IO ()
main = defaultMainWithHooks rsaUserHooks
 where  
  rsaUserHooks = simpleUserHooks { 
    runTests = runLMTests
  , instHook = filter_test $ instHook defaultUserHooks 
  }

type Hook a = PackageDescription -> LocalBuildInfo -> UserHooks -> a -> IO ()

filter_test :: Hook a -> Hook a
filter_test f pd lbi uhs x = f pd' lbi uhs x
 where
  pd'  = pd { executables = [] }

runLMTests :: Args -> Bool -> PackageDescription -> LocalBuildInfo -> IO ()
runLMTests _args _unknown descr _lbi = system test_exe >> return ()
 where
  test_exe = "dist"  "build"  "test_rsa"  (exeName $ head $ executables descr)

Takusen-0.8.5

#!/usr/bin/env runhaskell 

-- setup configure -fodbc -foracle -fpostgres -fsqlite

import Distribution.PackageDescription
  ( PackageDescription(..), Library(..), BuildInfo(..), HookedBuildInfo
  , emptyHookedBuildInfo, emptyBuildInfo
  )
import Distribution.PackageDescription.Parse ( writeHookedBuildInfo ) 
import Distribution.Package (Dependency(..), PackageName(..))
import Distribution.Simple.Setup ( ConfigFlags(..), BuildFlags(.. ), fromFlag)
import Distribution.Simple
  ( defaultMainWithHooks, autoconfUserHooks, UserHooks(..), Args )
import Distribution.Simple.Program (findProgramOnPath, simpleProgram, Program(..))
import Distribution.Simple.LocalBuildInfo (LocalBuildInfo)
import Distribution.Simple.Utils (warn, info, rawSystemStdout)
import Distribution.Verbosity (Verbosity)

import qualified System.Info (os)
import System.Directory (canonicalizePath, removeFile)
import System.Environment (getEnv)
import System.FilePath (combine, dropFileName, FilePath, pathSeparators)
import System.IO.Error (try)
import Data.List (isInfixOf)
import Data.Maybe (fromJust)
import Data.Monoid (mconcat)

{-
One install script to rule them all, and in the darkness build them...

See this page for useful notes on tagging and releasing:
  http://www.haskell.org/haskellwiki/How_to_write_a_Haskell_program

To-dos for Takusen:
 - Oracle resource leak: Ref Cursors (StmtHandles) not freed
 - Out bind parameters for ODBC
 - Multiple result-sets from ODBC procedure call
 - better result-set <-> iteratee validation. Check column types?
 - use hsc2hs to create #define constants from header files,
   rather than hard-code them.
 - Blob support (and clob?).
 - FreeTDS back-end.
 - POP3 & IMAP back-ends?

 - Unwritten tests:
   * incorrect fold function (doesn't match result-set)

-}


main = defaultMainWithHooks autoconfUserHooks
  { preConf=preConf, postConf=postConf
  , hookedPrograms = [pgConfigProgram, odbcConfigProgram, sqlite3Program, sqlplusProgram]
  }
  where
    preConf :: Args -> ConfigFlags -> IO HookedBuildInfo
    preConf args flags = do
      try (removeFile "Takusen.buildinfo")
      return emptyHookedBuildInfo
    postConf :: Args -> ConfigFlags -> PackageDescription -> LocalBuildInfo -> IO ()
    postConf args flags pkgdesc localbuildinfo = do
      let verbose = fromFlag (configVerbosity flags)
      let lbi = libBuildInfo (fromJust (library pkgdesc))
      let buildtools = buildTools lbi
      sqliteBI <- configSqlite3 verbose buildtools 
      pgBI <- configPG verbose buildtools
      oraBI <- configOracle verbose buildtools
      odbcBI <- configOdbc verbose buildtools
      let bi = mconcat [sqliteBI, pgBI, oraBI, odbcBI, lbi]
      writeHookedBuildInfo "Takusen.buildinfo" (Just bi, [])


-- ODBCConf.exe - MDAC install actions - command line?
odbcConfigProgram = simpleProgram "odbcconf" 
-- ODBC Admin console - GUI program
--odbcConfigProgram = simpleProgram "odbcad32"
sqlplusProgram    = simpleProgram "sqlplus"
pgConfigProgram   = simpleProgram "pg_config"
sqlite3Program    = simpleProgram "sqlite3"


isWindows = System.Info.os == "mingw32" || System.Info.os == "windows"

-- ghc-6.6.1 can't cope with a trailing slash or backslash on the end
-- of the include dir path, so we strip it off.
-- Not sure why this is; there might be something else causing it to fail
-- which has gone unnoticed.
stripTrailingSep :: String -> String
stripTrailingSep p
  = reverse
  . (\s -> if [head s] `isInfixOf` pathSeparators then drop 1 s else s)
  . reverse
  $ p

makeConfig path libDir includeDir = do
  libDirs <- canonicalizePath (combine path libDir)
  includeDirs <- canonicalizePath (combine path includeDir)
  return
    (emptyBuildInfo
      { extraLibDirs = [stripTrailingSep libDirs], includeDirs = [stripTrailingSep includeDirs] })

maybeGetEnv :: String -> IO (Maybe String)
maybeGetEnv env = do
  catch ( getEnv env >>= return . Just ) ( const (return Nothing) )

-- Check that the program is in the buildtools.
-- If it is, then run the action (which should return BuildInfo).
-- If not, return emptyBuildInfo.
-- Cabal populates the buildtools list depending on which flags
-- have been passed to "setup configure".
guardProg :: Program -> [Dependency] -> IO BuildInfo -> IO BuildInfo
guardProg prog tools action = do
  if prog `isElem` tools then action else return emptyBuildInfo
  where
    isElem program buildtools = or (map (match program) buildtools)
    match program (Dependency (PackageName tool) _) = (programName program) == tool

-- Run the first action to give a Maybe FilePath.
-- If this is Nothing then emit a warning about library not found.
-- Otherwise, run the second action over the FilePath.
guardPath :: (IO (Maybe FilePath)) -> String -> Verbosity -> (FilePath -> IO BuildInfo) -> IO BuildInfo
guardPath pathAction libName verbose resAction = do
  mb <- pathAction
  case mb of
    Nothing -> warn verbose ("No " ++libName++ " library found") >> return emptyBuildInfo
    Just path -> info verbose ("Using " ++libName++ ": " ++ path) >> resAction path

-- From the Oracle 10g manual:
--
-- Appendix D - Getting Started with OCI for Windows:
--   Compiling OCI Applications for Windows:
-- http://download.oracle.com/docs/cd/B19306_01/appdev.102/b14250/ociadwin.htm#i634569
-- Header files are in: ORACLE_BASE\ORACLE_HOME\oci\include
-- DLLs are in: ORACLE_BASE\ORACLE_HOME\bin
--
-- For Unix:
-- Appendix B - OCI Demonstration Programs:
-- http://download.oracle.com/docs/cd/B19306_01/appdev.102/b14250/ociabdem.htm#i459676
-- Header files are in: $ORACLE_HOME/rdbms/public
-- Header files are in: $ORACLE_HOME/lib

configOracle verbose buildtools = do
  guardProg sqlplusProgram buildtools $ do
  guardPath (maybeGetEnv "ORACLE_HOME") "Oracle" verbose $ \path -> do
  let (libDir, incDir) =
          if isWindows then ("bin", "oci/include") else ("lib", "rdbms/public")
  makeConfig path libDir incDir

configSqlite3 verbose buildtools = do
  guardProg sqlite3Program buildtools $ do
    if isWindows
      then guardPath (programFindLocation sqlite3Program verbose) "Sqlite3" verbose $ \path -> do
        makeConfig (dropFileName path) "" ""
      else return emptyBuildInfo

configPG verbose buildtools = do
  guardProg pgConfigProgram buildtools $ do
  guardPath (programFindLocation pgConfigProgram verbose) "PostgreSQL" verbose $ \pq_config_path -> do
  lib_dirs <- rawSystemStdout verbose pq_config_path ["--libdir"]
  inc_dirs <- rawSystemStdout verbose pq_config_path ["--includedir"]
  inc_dirs_server <- rawSystemStdout verbose pq_config_path ["--includedir-server"]
  return (emptyBuildInfo
    { extraLibDirs = words lib_dirs
    , includeDirs = words inc_dirs ++ words inc_dirs_server
    })


-- On Windows the ODBC stuff is in c:\windows\system32, which is always in the PATH.
-- So I think we only need to pass -lodbc32.
-- The include files are already in the ghc/include/mingw folder.
-- FIXME: I don't know how this should look for unixODBC.

configOdbc verbose buildtools | isWindows = do
  info verbose "Using ODBC:  lib already in PATH>"
  return emptyBuildInfo
configOdbc verbose buildtools = do
  --info verbose "Using odbc:  assume lib already in PATH>"
  return emptyBuildInfo

timberc-1.0.3

#! /usr/bin/env runhaskell

 
> import System.Cmd
> import System.Directory
> import System.FilePath

> import Distribution.Simple.UserHooks
> import Distribution.Simple.Setup
> import Distribution.Simple.Command
> import Distribution.Simple.Utils ( rawSystemExit )
> import Distribution.Simple -- (defaultMainWithHooks, autoconfUserHooks)
> import Distribution.Simple.InstallDirs  (CopyDest(..))
> import Distribution.Simple.LocalBuildInfo (absoluteInstallDirs, InstallDirs(..) )
> main = defaultMainWithHooks simpleUserHooks { postInst = myPostInst }

> buildRTS timberc dataDir
>  = do 
>       system("cd rtsPOSIX && chmod +x configure")
>       system("cd rtsPOSIX && ./configure --prefix=" ++ dataDir ++ " --with-timberc=" ++ timberc)
>       system("cd rtsPOSIX && make install")
>       return ()

> myPostInst args iflags pkg_descr lbi = do
>    let dirs = absoluteInstallDirs pkg_descr lbi NoCopyDest 
>        dataDir = datadir dirs
>        timberc = bindir dirs  "timberc"
>        script = "#!/bin/sh\n\nexec " ++ dataDir ++ "/timberc ${1+\"$@\"} --datadir " ++ dataDir ++ "\n"
>    copyFile timberc (dataDir  "timberc")
>    writeFile timberc script
>    buildRTS timberc dataDir
>    return ()


TimePiece-0.0.3

#!/usr/bin/env runghc
> import Data.List
> import Distribution.Simple
> import System.IO (hGetContents)
> import System.Process (waitForProcess, runInteractiveCommand)
> 
> main :: IO ()
> main = writeBuildInfo >> defaultMainWithHooks defaultUserHooks
> 
> writeBuildInfo :: IO ()
> writeBuildInfo = do
>    (_,out,_,pid) <- runInteractiveCommand "sdl-config --prefix --libs --cflags"
>    res <- hGetContents out
>    length res `seq` waitForProcess pid
>    case lines res of
>        (prefix@(_:_):libs@(_:_):cflags@(_:_):_) -> do
>            let x `isSubStringOf` s = or [ x `isPrefixOf` t | t <- tails s ]
>            writeFile "TimePiece.buildinfo" $ unlines
>                [ "Include-Dirs: " ++ prefix ++ "/include"
>                , "Extra-Lib-Dirs: " ++ prefix ++ "/lib"
>                , "CC-Options: " ++ cflags
>                , "GHC-Options: " ++ unwords (map ("-optc"++) $ words cflags)
>                ] ++ if "SDLmain" `isSubStringOf` libs
>                    then "Extra-Libraries: SDLmain\n"
>                    else ""
>        _  -> return ()

uacpid-0.0.4

#! /usr/bin/env runhaskell

-- Copyright: 2009 Dino Morelli
-- License: BSD3 (see LICENSE)
-- Author: Dino Morelli 

import Control.Monad
import Distribution.Simple
import Distribution.Simple.LocalBuildInfo
import Distribution.Simple.Setup
import System.Cmd
import System.Directory
import System.Exit
import System.FilePath


copyManDestDir :: CopyFlags -> LocalBuildInfo -> FilePath
copyManDestDir copyFlags localBuildInfo = destDir
   where
      Flag (CopyTo copyPrefix) = copyDest copyFlags

      instPrefix = fromPathTemplate $ prefix
         $ installDirTemplates localBuildInfo

      {- Can't use  here because instPrefix is often absolute
         and  returns the second path if ALONE if it's absolute.
         Safer to just have the extra / if that's how it goes.
      -}
      destDir = copyPrefix ++ "/" ++ instPrefix
          "share"  "man"  "man1"


instManDestDir :: LocalBuildInfo -> FilePath
instManDestDir localBuildInfo = destDir
   where
      {- There's a "right way" to get the absolute mandir FilePath 
         from the Cabal API, but I can't figure it out yet.
         Have to revisit someday.
      -}
      instPrefix = fromPathTemplate $ prefix
         $ installDirTemplates localBuildInfo

      destDir = instPrefix  "share"  "man"  "man1"


copyManPage :: FilePath -> IO ()
copyManPage destDir = do
   -- Construct src dir for copying the man page
   let manFile = "uacpid.1"
   let srcPath = "resources"  "man"  manFile

   createDirectoryIfMissing True destDir

   putStrLn $ "Installing man page in " ++ destDir

   let destPath = destDir  manFile

   -- Copy it to the appropriate man directory
   copyFile srcPath destPath

   -- gzip the man page
   gzipExitCode <- system $ "gzip -f " ++ destPath

   unless (gzipExitCode == ExitSuccess) $
      putStrLn "Copy of man page failed!"

   return ()


main = defaultMainWithHooks (simpleUserHooks 
   { postCopy = customPostCopy
   , postInst = customPostInst
   } )
   where
      customPostCopy _ copyFlags _ localBuildInfo =
         copyManPage (copyManDestDir copyFlags localBuildInfo)
      customPostInst _ _ _ localBuildInfo =
         copyManPage (instManDestDir localBuildInfo)

uconv-0.0.3

#!/usr/bin/env runghc
> import Distribution.Simple
> import System.IO (hGetContents)
> import System.Process (waitForProcess, runInteractiveCommand)
> 
> main :: IO ()
> main = writeBuildInfo >> defaultMainWithHooks defaultUserHooks
> 
> writeBuildInfo :: IO ()
> writeBuildInfo = do
>    (_,out,_,pid) <- runInteractiveCommand "icu-config --prefix"
>    res <- hGetContents out
>    length res `seq` waitForProcess pid
>    case lines res of
>        (prefix@(_:_):_) -> do
>            writeFile "uconv.buildinfo" $ unlines
>                [ "Include-Dirs: " ++ prefix ++ "/include"
>                , "Extra-Lib-Dirs: " ++ prefix ++ "/lib"
>                ]
>        _  -> return ()

vect-0.4.5

#! /usr/bin/env runhaskell
>
> import Control.Monad
> import Distribution.Simple
> import Distribution.PackageDescription
> import System.IO
> import System.Directory
>
> copyFileWithPrefix src tgt prefix = 
>   readFile src >>= \txt -> writeFile tgt (prefix ++ txt)
>
> copyFiles srcdir tgtdir prefix = do
>   files <- getDirectoryContents srcdir
>   forM_ files $ \fname -> do
>     let src = srcdir ++ fname
>         tgt = tgtdir ++ fname
>     doesFileExist src >>= \b -> when b $ copyFileWithPrefix src tgt prefix
>     doesDirectoryExist src>>= \b -> when ( b && fname /= "." && fname /= ".." ) $ do
>       createDirectoryIfMissing False tgt
>       copyFiles (src ++ "/") (tgt ++ "/") prefix
>
> thePrefix flt = "{-# OPTIONS_GHC -DFlt=" ++ flt ++ " -DVECT_" ++ flt ++ " #-}\n"
>
> myPreBuildHook args buildflags = do
>   createDirectoryIfMissing False "Data/Vect/Float"
>   createDirectoryIfMissing False "Data/Vect/Double"
>   copyFileWithPrefix "src/flt.hs" "Data/Vect/Float.hs"  (thePrefix "Float")
>   copyFileWithPrefix "src/flt.hs" "Data/Vect/Double.hs" (thePrefix "Double")
>   copyFiles "src/flt/" "Data/Vect/Float/"  (thePrefix "Float")
>   copyFiles "src/flt/" "Data/Vect/Double/" (thePrefix "Double")
>   return $ emptyHookedBuildInfo  
>
> myPostCleanHook args cleanflags pdep mlocalbuildinfo = do
>   removeDirectoryRecursive "Data/Vect/Float"
>   removeDirectoryRecursive "Data/Vect/Double"
>
> myUserHooks = simpleUserHooks 
>   { preBuild = myPreBuildHook 
>   , postClean = myPostCleanHook
>   }
>
> main = do
>   defaultMainWithHooks myUserHooks
>

webidl-0.1.1

module Main (main) where

import Control.Monad
import System.Process
import System.Exit
import Distribution.Simple
import Distribution.Simple.Setup
import Distribution.PackageDescription

main :: IO ()
main = defaultMainWithHooks simpleUserHooks {
  preConf = buildLexer
}

buildLexer :: Args -> ConfigFlags -> IO HookedBuildInfo

buildLexer args cflgs = do
  let cmd = "cd cbits; make lexer-pkg"
  runCommand cmd >>= waitForProcess
  return emptyHookedBuildInfo


wxcore-0.12.1.2

import Data.List                          (foldl', intercalate, nub)
import Data.Maybe                         (fromJust)
import Distribution.PackageDescription
import Distribution.Simple
import Distribution.Simple.LocalBuildInfo (LocalBuildInfo, localPkgDescr)
import Distribution.Simple.Setup          (ConfigFlags)
import System.Cmd                         (system)
import System.FilePath.Posix              ((), (<.>))
import System.Directory                   (createDirectoryIfMissing)
import System.Process                     (readProcess)

-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --

main :: IO ()
main = defaultMainWithHooks simpleUserHooks { confHook = myConfHook }

-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --

sourceDirectory  :: FilePath
eiffelDirectory  :: FilePath
includeDirectory :: FilePath
wxcoreDirectory  :: FilePath

sourceDirectory  = "src"
eiffelDirectory  = sourceDirectory  "eiffel"
includeDirectory = sourceDirectory  "include"
wxcoreDirectory  = sourceDirectory  "haskell/Graphics/UI/WXCore"

-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --

wxcoreIncludeFile :: FilePath
wxcoreIncludeFile = includeDirectory  "wxc.h"

eiffelFiles :: [FilePath]
eiffelFiles =
    map ((<.> "e") . (eiffelDirectory )) names
  where
    names = ["wxc_defs", "wx_defs", "stc"]

-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --

myConfHook :: (Either GenericPackageDescription PackageDescription, HookedBuildInfo) -> ConfigFlags -> IO LocalBuildInfo
myConfHook (pkg0, pbi) flags = do
    createDirectoryIfMissing True wxcoreDirectory
    system $ "wxdirect -t --wxc " ++ sourceDirectory ++ " -o " ++ wxcoreDirectory ++ " " ++ wxcoreIncludeFile
    system $ "wxdirect -i --wxc " ++ sourceDirectory ++ " -o " ++ wxcoreDirectory ++ " " ++ wxcoreIncludeFile
    system $ "wxdirect -c --wxc " ++ sourceDirectory ++ " -o " ++ wxcoreDirectory ++ " " ++ wxcoreIncludeFile
    system $ "wxdirect -d --wxc " ++ sourceDirectory ++ " -o " ++ wxcoreDirectory ++ " " ++ intercalate " " eiffelFiles

    wx <- fmap parseWxConfig (readProcess "wx-config" ["--libs", "--cppflags"] "")
    lbi <- confHook simpleUserHooks (pkg0, pbi) flags

    let lpd   = localPkgDescr lbi
    let lib   = fromJust (library lpd)
    let libbi = libBuildInfo lib

    let libbi' = libbi
          { extraLibDirs = extraLibDirs libbi ++ extraLibDirs wx
          , extraLibs    = extraLibs    libbi ++ extraLibs    wx
          , ldOptions    = ldOptions    libbi ++ ldOptions    wx ++ ["-lstdc++"]
          , frameworks   = frameworks   libbi ++ frameworks   wx
          , includeDirs  = includeDirs  libbi ++ includeDirs  wx
          , ccOptions    = ccOptions    libbi ++ ccOptions    wx ++ ["-DwxcREFUSE_MEDIACTRL"]
          }

    let lib' = lib { libBuildInfo = libbi' }
    let lpd' = lpd { library = Just lib' }

    return $ lbi { localPkgDescr = lpd' }

-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --

parseWxConfig :: String -> BuildInfo
parseWxConfig s =
    helper emptyBuildInfo (words s)
  where
    helper b ("-framework":w:ws) = helper (b { frameworks = w : frameworks b }) ws
    helper b (w:ws)              = helper (f b w) ws
    helper b []                  = b
    f b w =
        case w of
          ('-':'L':v) -> b { extraLibDirs = v : extraLibDirs b }
          ('-':'l':v) -> b { extraLibs    = v : extraLibs b }
          ('-':'I':v) -> b { includeDirs  = v : includeDirs b }
          ('-':'D':_) -> b { ccOptions    = w : ccOptions b }
          _           -> b

YamlReference-0.9.3

import Distribution.Simple
import System.Cmd
main = defaultMainWithHooks $ simpleUserHooks { runTests = run, preClean = clean }
    where run _ _ _ _ = do
            system "dist/build/yaml2yeast-test/yaml2yeast-test tests"
            return ()
          clean _ _ = do
            system "rm -f tests/*.error"
            return (Nothing, [])

zeroth-2009.6.23.3

#!/usr/bin/env runhaskell
> import Distribution.ZeroTH
> main = zeroTHCabalMain (Just ["Data.Derive"]) ["--hashes"] ["Language/Haskell/TH/ZeroTH/GetOpt.hs"]


Test-only custom Setup files


attempt-0.2.0

#!/usr/bin/env runhaskell

> module Main where
> import Distribution.Simple
> import System.Cmd (system)

> main :: IO ()
> main = defaultMainWithHooks (simpleUserHooks { runTests = runTests' })

> runTests' :: a -> b -> c -> d -> IO ()
> runTests' _ _ _ _ = system "runhaskell Test.hs" >> return ()

bimap-0.2.4

#!/usr/bin/env runhaskell
> import Distribution.Simple
> import System.Cmd
> import System.Exit

> main = defaultMainWithHooks (simpleUserHooks { runTests = suite })
>     where
>     suite _ _ _ _ = system "bash tests.sh" >> return ()


binary-protocol-1.0

import Control.Monad
import Distribution.Simple
import System.Exit
import System.IO
import System.Process
import Text.Printf

main = defaultMainWithHooks (simpleUserHooks {runTests = runzeTests})

runzeTests _ _ _ _= do
  putStrLn "Checking for required modules..."
  found <- forM ["test-framework","test-framework-hunit"] $ \package_name -> do
    putStr $ printf "Checking for package %s...  " package_name
    hFlush stdout
    error_code <- system $ printf "ghc-pkg field %s version" package_name
    return (error_code == ExitSuccess)
  when ((not.and) found) $ do
    putStrLn "One or more packages needed for testing was not found."
    exitWith $ ExitFailure 1
  putStrLn ""
  putStrLn "Running tests..."
  putStrLn ""
  system "runhaskell -i. -i./tests tests/runtests.hs"
  return ()

bytestring-show-0.3.2

#!/usr/bin/env runhaskell
> import Distribution.Simple
> import System.Cmd (system)

> main = defaultMainWithHooks (simpleUserHooks { runTests = tests })

> tests _ _ _ _ = system "runhaskell Tests/Properties.hs" >> return ()

cflp-2009.2.1

% Cabal Setup File for the `cflp` Package
% Sebastian Fischer (sebf@informatik.uni-kiel.de)
% November, 2008

> import System.Process
> import System.Exit
> import Distribution.Simple
>
> main = defaultMainWithHooks $ simpleUserHooks { runTests = runTestSuite }
>
> runTestSuite _ _ _ _ =
>   runCommand "ghc -i.:src -hide-package transformers -hide-package monads-fd -e main Test.lhs" >>= waitForProcess >>= exitWith



CouchDB-0.8.1.2

#!/usr/bin/env runhaskell
> import Distribution.Simple
> import System.Directory (setCurrentDirectory)
> import System.Process (runCommand,waitForProcess)


> main = defaultMainWithHooks simpleUserHooks { runTests = tests }

> tests _ _ _ _ = do
>   setCurrentDirectory "src"
>   h <- runCommand "/usr/bin/env runhaskell Database.CouchDB.Tests" 
>   waitForProcess h
>   return ()

crc16-0.1.0

import Distribution.Simple
import Data.Digest.CRC16
import Test.HUnit.Text
import Tests

main = 
    defaultMainWithHooks ( simpleUserHooks { runTests = test_crc16 } )
    where
        test_crc16 _ _ _ _ = do runTestTT tests
                                return ()

crockford-0.1

#! /usr/bin/env runhaskell

> import Distribution.Simple
> import System.Cmd
> tests _ _ _ _ = system "runhaskell src/Tests.hs" >> return ()
> main = defaultMainWithHooks (simpleUserHooks {runTests = tests})


denominate-0.5.0

import Distribution.Simple
import Distribution.PackageDescription (PackageDescription)
import Distribution.Simple.LocalBuildInfo (LocalBuildInfo, buildDir)
import System.Exit
import Control.Monad
import System.Process

main :: IO ()
main = defaultMainWithHooks (simpleUserHooks { runTests = test })

test :: Args -> Bool -> PackageDescription -> LocalBuildInfo -> IO ()
test _ _ _ _ = runCommand commandStr >>= waitForProcess >> return ()
  where commandStr = "runhaskell TestRunner +names System/Denominate_Test.hs"

dequeue-0.1.4

#! /usr/bin/env runhaskell

> import Distribution.Simple
> import System.Cmd
> tests _ _ _ _ = system "runhaskell src/Tests.hs" >> return ()
> main = defaultMainWithHooks (simpleUserHooks {runTests = tests})


digits-0.1

#! /usr/bin/env runhaskell

> import Distribution.Simple
> import System.Cmd
> tests _ _ _ _ = system "runhaskell src/Tests.hs" >> return ()
> main = defaultMainWithHooks (simpleUserHooks {runTests = tests})


dnsrbl-0.0.3

#!/usr/bin/env runhaskell
>import Distribution.Simple
>import Distribution.Simple
>import Distribution.PackageDescription(PackageDescription,dataFiles)
>import Distribution.Simple.LocalBuildInfo(LocalBuildInfo)
>import System.Cmd(system)
>import Distribution.Simple.LocalBuildInfo
>import System.IO(FilePath)

>main :: IO ()
>main = defaultMainWithHooks (simpleUserHooks {runTests = runzeTests})

>runzeTests:: Args -> Bool -> PackageDescription -> LocalBuildInfo -> IO ()
>runzeTests a b pd lb = system ( "runhaskell  ./tests/dnsrbltest.hs") >> return()


dwarf-0.1

import Distribution.Simple
import System.Cmd(system)

main = defaultMainWithHooks $ simpleUserHooks { runTests = runElfTests }

runElfTests a b pd lb = system "runhaskell -i./src ./tests/Test.hs" >> return ()

either-unwrap-1.1

import Control.Monad
import Distribution.Simple
import System.Exit
import System.IO
import System.Process
import Text.Printf

main = defaultMainWithHooks (simpleUserHooks {runTests = runzeTests})

runzeTests _ _ _ _= do
  putStrLn "Checking for required modules..."
  found <- forM ["test-framework","test-framework-hunit"] $ \package_name -> do
    putStr $ printf "Checking for package %s...  " package_name
    hFlush stdout
    error_code <- system $ printf "ghc-pkg field %s version" package_name
    return (error_code == ExitSuccess)
  when ((not.and) found) $ do
    putStrLn "One or more packages needed for testing was not found."
    exitWith $ ExitFailure 1
  putStrLn ""
  putStrLn "Running tests..."
  putStrLn ""
  system "runhaskell -i. -i./tests tests/runtests.hs"
  return ()

elf-0.2

import Distribution.Simple
import System.Cmd(system)

main = defaultMainWithHooks $ simpleUserHooks { runTests = runElfTests }

runElfTests a b pd lb = system "runhaskell -i./src ./tests/Test.hs" >> return ()

error-message-1.0.1

import Control.Monad
import Distribution.Simple
import System.Exit
import System.IO
import System.Process
import Text.Printf

main = defaultMainWithHooks (simpleUserHooks {runTests = runzeTests})

runzeTests _ _ _ _= do
  putStrLn "Checking for required modules..."
  found <- forM ["test-framework","test-framework-hunit"] $ \package_name -> do
    putStr $ printf "Checking for package %s...  " package_name
    hFlush stdout
    error_code <- system $ printf "ghc-pkg field %s version" package_name
    return (error_code == ExitSuccess)
  when ((not.and) found) $ do
    putStrLn "One or more packages needed for testing was not found."
    exitWith $ ExitFailure 1
  putStrLn ""
  putStrLn "Running tests..."
  putStrLn ""
  system "runhaskell -i. -i./tests tests/runtests.hs"
  return ()

explicit-sharing-0.5.1.2

import System.Process
import System.Exit
import Distribution.Simple

main = defaultMainWithHooks $ simpleUserHooks { runTests = runTestSuite }

runTestSuite _ _ _ _ =
 do pid <- runCommand $ "ghc -hide-package monads-fd "
                     ++ "-hide-package transformers -e main Test.hs"
    waitForProcess pid >>= exitWith


fez-conf-1.0.1

#! /usr/bin/env runhaskell

import Distribution.Simple
import System.Cmd


main = defaultMainWithHooks (simpleUserHooks { runTests = testRunner } )
   where
      testRunner _ _ _ _ = do
         system $ "runhaskell -isrc -itestsuite -itestsuite/src testsuite/runtests.hs"
         return ()

filestore-0.3.3.1

#!/usr/bin/env runhaskell
> import Distribution.Simple
> import System.Process
> import System.Exit

> main = defaultMainWithHooks $ simpleUserHooks { runTests  = runTestSuite }

Run test suite.

> runTestSuite _ _ _ _ = runCommand "runghc -idist/build/autogen Tests.lhs" >>= waitForProcess >>= exitWith


hebrew-time-0.0.0

#!/usr/bin/env runhaskell

> module Main where
> import Distribution.Simple
> import System.Cmd (system)

> main :: IO ()
> main = defaultMainWithHooks (simpleUserHooks { runTests = runTests' })

> runTests' :: a -> b -> c -> d -> IO ()
> runTests' _ _ _ _ = system "runhaskell Test.hs" >> return ()

hmatrix-0.6.0.0

#! /usr/bin/env runhaskell

> import Distribution.Simple
> import System(system)

> main = defaultMainWithHooks autoconfUserHooks {runTests = t}

> t _ _ _ _ = system ( "runhaskell examples/tests.hs") >> return()

hogg-0.4.1

#!/usr/bin/env runhaskell

import Distribution.Simple (defaultMainWithHooks, simpleUserHooks,
                             UserHooks(..), Args)

{-
-- The test-related options have been disabled due to incompitibilities
-- in various Cabal release versions. In particular, the type expected for
-- runTests has changed, and joinPaths was not exported in Cabal 1.1.6
import           Distribution.PackageDescription (PackageDescription)
import           Distribution.Simple.LocalBuildInfo (LocalBuildInfo)
import qualified Distribution.Simple.LocalBuildInfo as LBI
import           Distribution.Simple.Utils (rawSystemVerbose)
import           Distribution.Compat.FilePath (joinPaths)
import System.Exit(ExitCode(..))
-}

main :: IO ()
main = defaultMainWithHooks (simpleUserHooks)
-- main = defaultMainWithHooks (defaultUserHooks{runTests = tests})

{-
-- Definition of tests for Cabal 1.1.3
tests :: Args -> Bool -> LocalBuildInfo -> IO ExitCode
tests args _ lbi =
    let testCmd = foldl1 joinPaths [LBI.buildDir lbi, "ListMergeTest", "ListMergeTest"]
    in  rawSystemVerbose 1 testCmd
        ("+RTS" : "-M32m" : "-c30" : "-RTS" : args)
-}

{-
-- Definition of tests for Cabal 1.1.7
tests :: Args -> Bool -> PackageDescription -> LocalBuildInfo -> IO ExitCode
tests args _ _ lbi =
    let testCmd = foldl1 joinPaths [LBI.buildDir lbi, "ListMergeTest", "ListMergeTest"]
    in  rawSystemVerbose 1 testCmd
        ("+RTS" : "-M32m" : "-c30" : "-RTS" : args)
-}

hslogger-template-1.0.0

module Main (main) where

import System.Process (system)

import Distribution.Simple (defaultMainWithHooks, simpleUserHooks, runTests)

main :: IO ()
main =
    defaultMainWithHooks $ simpleUserHooks { runTests = runTests' }
  where
    runTests' _ _ _ _ = do
        system "runhaskell -i./src src/test.hs"
        return ()

hunit-gui-0.1.3

import Distribution.PackageDescription
import Distribution.Simple
import Distribution.Simple.LocalBuildInfo
import System.Cmd
import System.Exit


main :: IO ()
main = defaultMainWithHooks (simpleUserHooks { runTests = runAllTests })

runAllTests :: Args -> Bool -> PackageDescription -> LocalBuildInfo -> IO ()
runAllTests _ _ _ _ = do
  code <- system "./dist/build/tests/tests"
  exitWith code

ieee-0.6

#!/usr/bin/env runhaskell
> import Distribution.Simple
> import System.Cmd
>
> testing _ _ _ _ = system "runhaskell tests/Properties.hs" >> return ()
>
> main = defaultMainWithHooks simpleUserHooks
>        {runTests=testing}

interpolatedstring-perl6-0.4

import Distribution.Simple
import System.Cmd(system)

main = defaultMainWithHooks $ simpleUserHooks { runTests = runElfTests }

runElfTests a b pd lb = system "runhaskell -i./src ./tests/Test.hs" >> return ()

interpolatedstring-qq-0.1

import Distribution.Simple
import System.Cmd(system)

main = defaultMainWithHooks $ simpleUserHooks { runTests = runElfTests }

runElfTests a b pd lb = system "runhaskell -i./src ./tests/Test.hs" >> return ()

JsContracts-0.5.1

#!/usr/bin/env runhaskell
> import Distribution.Simple
> import qualified Data.List as L
> import System.Directory
> import System.Process (runCommand,waitForProcess)
> import System.IO (hPutStrLn, stderr)

> isHaskellFile file = ".lhs" `L.isSuffixOf` file || ".hs" `L.isSuffixOf` file

> moduleName file = L.takeWhile (\ch -> ch /= '.') file

> testMain _ _ _ _ = do
>   files <- getDirectoryContents "tests"
>   let tests = filter isHaskellFile files
>   let testModules = map moduleName tests
>   let testFuncs = map (++ ".main") testModules
>   let testExpr = "sequence [ " ++ concat (L.intersperse "," testFuncs) ++ 
>                  " ] >>= \\cases -> runTestTT (TestList cases)"
>   let moduleLine = concat (L.intersperse " " testModules)
>   let cmd = "cd tests && ghc  -XNoMonomorphismRestriction -fglasgow-exts " ++
>             "-package HUnit -package WebBits -package parsec-2.1.0.1 -i../src:../dist/build/autogen -e \"" ++ 
>             testExpr ++ " >> return ()\" " ++ moduleLine
>   handle <- runCommand cmd
>   waitForProcess handle
>   hPutStrLn stderr "Testing complete.  Errors reported above (if any)."
 

> main = defaultMainWithHooks (simpleUserHooks { runTests = testMain })

language-dot-0.0.3

module Main where

import Distribution.Simple (defaultMainWithHooks, simpleUserHooks, runTests)
import System.Process      (system)

main :: IO ()
main =
    defaultMainWithHooks $ simpleUserHooks { runTests = runTests' }
  where
    runTests' _ _ _ _ = do
        system "runhaskell -DTEST -i./src src/test.hs"
        return ()

luhn-0.1

#! /usr/bin/env runhaskell

> import Distribution.Simple
> import System.Cmd
> tests _ _ _ _ = system "runhaskell src/Tests.hs" >> return ()
> main = defaultMainWithHooks (simpleUserHooks {runTests = tests})


macho-0.2

module Main where
    
import Distribution.Simple
import System.Cmd(system)

main = defaultMainWithHooks $ simpleUserHooks { runTests = runTests_ }

runTests_ a b pd lb = system "runhaskell -i./src ./tests/Test.hs" >> return ()

matrix-market-1.2

#!/usr/bin/env runhaskell
> import Distribution.Simple
> import System.Cmd
>
> testing _ _ _ _ = system "runhaskell tests/Properties.hs" >> return ()
>
> main = defaultMainWithHooks defaultUserHooks
>        {runTests=testing}

network-bytestring-0.1.2.1

module Main (main) where

import Distribution.Simple (defaultMainWithHooks, runTests, simpleUserHooks)
import System.Cmd (system)

main :: IO ()
main = defaultMainWithHooks $ simpleUserHooks { runTests = runTests' } where
  runTests' _ _ _ _ = do
    system "runhaskell -i./dist/build tests/Simple.hs"
    return ()

network-dbus-0.0

import Distribution.Simple
import Distribution.Simple.Utils (rawSystemExit)
import Distribution.Verbosity (normal)

main = defaultMainWithHooks $
    simpleUserHooks { runTests = runDBusTests }

runDBusTests _ _ _ _ = rawSystemExit normal "runhaskell" ["test.hs"]


Operads-1.0

import Distribution.Simple
import Distribution.PackageDescription(PackageDescription)
import Distribution.Simple.LocalBuildInfo(LocalBuildInfo)
import System.Cmd(system)
import Distribution.Simple.LocalBuildInfo

main = defaultMainWithHooks (simpleUserHooks {runTests = runzeTests})

runzeTests:: Args -> Bool -> PackageDescription -> LocalBuildInfo -> IO ()
runzeTests a b pd lb = system ( "./dist/build/OperadTest/OperadTest") >> return()

osx-ar-0.1

module Main where
    
import Distribution.Simple
import System.Cmd(system)

main = defaultMainWithHooks $ simpleUserHooks { runTests = runTests_ }

runTests_ a b pd lb = system "runhaskell -i./src ./tests/Test.hs" >> return ()

PageIO-0.0.3

#!/usr/bin/env runhaskell
> import Distribution.Simple
> import System.Cmd
> import System.Exit
> import System.Directory
> main = defaultMainWithHooks (simpleUserHooks { runTests = quickCheck } )
>     where
>     quickCheck _ _ _ _ = do
>         ec <- system $ "ghc --make -odir dist/build -hidir dist/build -idist/build:src t/runTests.hs -L/usr/lib -liconv -luuid -o t/runTests"
>         case ec of
>             ExitSuccess -> do
>                 system "t/runTests"
>             _           -> return ec
>         return ()

pecoff-0.1

import Distribution.Simple
import System.Cmd(system)

main = defaultMainWithHooks $ simpleUserHooks { runTests = runPecoffTests }

runPecoffTests a b pd lb = system "runhaskell -i./src ./tests/Test.hs" >> return ()

permutation-0.4.1

#!/usr/bin/env runhaskell
> import Distribution.Simple
> import System.Cmd
> import System.Exit ( ExitCode(..) )
>
> testing _ _ _ _ = do
>     err <- system "make -C tests"
>     system "make -s -C tests clean"
>     if err /= ExitSuccess
>         then ioError $ userError $ "failed"
>         else return ()
>
> main = defaultMainWithHooks simpleUserHooks
>        {runTests=testing}

photoname-2.2

#!/usr/bin/env runhaskell

> import Distribution.Simple
> import System.Cmd


> main = defaultMainWithHooks (simpleUserHooks { runTests = testRunner } )
>     where
>        testRunner _ _ _ _ = do
>           system $ "runhaskell -itestsuite testsuite/runtests.hs"
>           return ()

prelude-plus-0.0.0.6

#!/usr/bin/env runhaskell
> import Distribution.Simple
> import Distribution.Simple.LocalBuildInfo
> import System.FilePath (())
> import System.Cmd (system)
>
> main = defaultMainWithHooks simpleUserHooks { runTests = runTests' }
>
> runTests' _ _ _ lbi = system testprog >> return ()
>   where testprog = buildDir lbi  "test"  "test"

procrastinating-variable-1.0.2

import Control.Monad
import Distribution.Simple
import System.Exit
import System.IO
import System.Process
import Text.Printf

main = defaultMainWithHooks (simpleUserHooks {runTests = runzeTests})

runzeTests _ _ _ _= do
  putStrLn "Checking for required modules..."
  found <- forM ["test-framework","test-framework-hunit"] $ \package_name -> do
    putStr $ printf "Checking for package %s...  " package_name
    hFlush stdout
    error_code <- system $ printf "ghc-pkg field %s version" package_name
    return (error_code == ExitSuccess)
  when ((not.and) found) $ do
    putStrLn "One or more packages needed for testing was not found."
    exitWith $ ExitFailure 1
  putStrLn ""
  putStrLn "Running tests..."
  putStrLn ""
  system "runhaskell -i. -i./tests tests/runtests.hs"
  return ()

rewriting-0.2.1

module Main (main) where

import Distribution.Simple
import System.Cmd (system)
import System.FilePath (())
import System.Directory (doesDirectoryExist, removeDirectoryRecursive)

main :: IO ()
main = defaultMainWithHooks hooks where
  hooks = simpleUserHooks { runTests = runTests' }

runTests' _ _ _ _ = system cmd >> return ()
  where testdir = "dist"  "build"  "test"
        testcmd = "."  "test"
        cmd = "cd " ++ testdir ++ " && " ++ testcmd


time-1.1.4

module Main (main) where

import Control.Exception
import Distribution.PackageDescription
import Distribution.Simple
import Distribution.Simple.LocalBuildInfo
import Distribution.Simple.Utils
import System.Cmd
import System.Directory
import System.Info

main :: IO ()
main = case os of
    "windows" -> defaultMain
    "mingw32" -> defaultMain
    _ -> let hooks = autoconfUserHooks { runTests = runTestScript } in defaultMainWithHooks hooks

withCurrentDirectory :: FilePath -> IO a -> IO a
withCurrentDirectory path f = do
    cur <- getCurrentDirectory
    setCurrentDirectory path
    finally f (setCurrentDirectory cur)

runTestScript :: Args -> Bool -> PackageDescription -> LocalBuildInfo -> IO ()
runTestScript _args _flag _pd _lbi
 = maybeExit $ withCurrentDirectory "test" $ system "make"

tkhs-0.2.2

#!/usr/bin/env runhaskell
> import Distribution.Simple
> import Distribution.Simple.LocalBuildInfo
> import System.FilePath (())
> import System.Cmd (system)
>
> main = defaultMainWithHooks simpleUserHooks { runTests = runTests' }
>
> runTests' _ _ _ lbi = system testprog >> return ()
>   where testprog = buildDir lbi  "test"  "test"

tokyocabinet-haskell-0.0.5

import Distribution.Simple
import Distribution.PackageDescription
import Distribution.Simple.LocalBuildInfo (LocalBuildInfo(..))

import System.Cmd (system)
import System.FilePath

main = defaultMainWithHooks $ simpleUserHooks { runTests = myTestRunner }

myTestRunner :: Args -> Bool -> PackageDescription -> LocalBuildInfo -> IO ()
myTestRunner _ _ pkg_descr lbi =  mapM_ (system . path) $ executables pkg_descr
    where
      path exec = let name = (dropExtension . exeName) exec
                  in (buildDir lbi)  name  name

txt-sushi-0.4.0

import Distribution.PackageDescription(PackageDescription)
import Distribution.Simple
import Distribution.Simple.LocalBuildInfo(LocalBuildInfo)

import Text.ParserCombinators.Parsec

import Database.TxtSushi.SQLParser

main = defaultMainWithHooks $ simpleUserHooks {runTests = runTxtSushiTests}

--------------------------------------------------------------------------------
-- Test code
--------------------------------------------------------------------------------

runTxtSushiTests :: Args -> Bool -> PackageDescription -> LocalBuildInfo -> IO ()
runTxtSushiTests _ _ _ _ = do
    let
        -- test statement 1
        stmt1 = SelectStatement {
                    columnSelections = [
                        ExpressionColumn {expression = ColumnExpression {column = ColumnIdentifier {maybeTableName = Just "table1", columnId = "col1"}}},
                        AllColumnsFrom {sourceTableName = "table2"}],
                    maybeFromTable = Just (
                        InnerJoin {
                            leftJoinTable = TableIdentifier {tableName = "table1", maybeTableAlias = Nothing},
                            rightJoinTable = TableIdentifier {tableName = "table2", maybeTableAlias = Nothing},
                            onCondition = FunctionExpression {
                                sqlFunction = SQLFunction {functionName = "=", minArgCount = 2, argCountIsFixed = True},
                                functionArguments = [
                                    ColumnExpression {column = ColumnIdentifier {maybeTableName = Just "table1", columnId = "col1"}},
                                    ColumnExpression {column = ColumnIdentifier {maybeTableName = Just "table2", columnId = "col1"}}]},
                            maybeTableAlias = Nothing}),
                    maybeWhereFilter = Nothing,
                    orderByItems = [],
                    maybeGroupByHaving = Nothing}
        stmt1_1Txt =
            "select table1.col1, table2.* " ++
            "from table1 inner join table2 on table1.col1 = table2.col1"
        stmt1_2Txt =
            "select table1.col1, table2.* " ++
            "from table1 join table2 on table1.col1 = table2.col1"
        
        -- test statement 2
        stmt2 = SelectStatement {
                    columnSelections = [
                        ExpressionColumn {expression = ColumnExpression {column = ColumnIdentifier {maybeTableName = Just "table1", columnId = "col1"}}},
                        AllColumnsFrom {sourceTableName = "table2"}],
                    maybeFromTable = Just (
                        InnerJoin {
                            leftJoinTable = TableIdentifier {tableName = "table1", maybeTableAlias = Nothing},
                            rightJoinTable = TableIdentifier {tableName = "table2", maybeTableAlias = Nothing},
                            onCondition = FunctionExpression {
                                sqlFunction = SQLFunction {functionName = "=", minArgCount = 2, argCountIsFixed = True},
                                functionArguments = [
                                    ColumnExpression {column = ColumnIdentifier {maybeTableName = Just "table1", columnId = "col1"}},
                                    ColumnExpression {column = ColumnIdentifier {maybeTableName = Just "table2", columnId = "col1"}}]},
                            maybeTableAlias = Nothing}),
                    maybeWhereFilter = Just (
                        FunctionExpression {
                            sqlFunction = SQLFunction {functionName = "<>", minArgCount = 2, argCountIsFixed = True},
                            functionArguments = [
                                FunctionExpression {
                                    sqlFunction = SQLFunction {functionName = "UPPER", minArgCount = 1, argCountIsFixed = True},
                                    functionArguments = [ColumnExpression {column = ColumnIdentifier {maybeTableName = Just "table1", columnId = "col1"}}]},
                                FunctionExpression {
                                    sqlFunction = SQLFunction {functionName = "LOWER", minArgCount = 1, argCountIsFixed = True},
                                    functionArguments = [ColumnExpression {column = ColumnIdentifier {maybeTableName = Just "table1", columnId = "col1"}}]}]}),
                    orderByItems = [],
                    maybeGroupByHaving = Nothing}
        stmt2_1Txt =
            "select table1.col1, table2.* " ++
            "from table1 join table2 on table1.col1 = table2.col1 " ++
            "where upper(table1.col1)<>lower(table1.col1)"
        stmt2_2Txt =
            "select table1.col1, table2.* " ++
            "from table1 join table2 on table1.col1 = table2.col1 " ++
            "where upper(table1.col1) <> lower(table1.col1)"
        
        -- test statement 3
        stmt3 = SelectStatement {
                    columnSelections = [
                        ExpressionColumn {expression = ColumnExpression {column = ColumnIdentifier {maybeTableName = Just "table1", columnId = "col1"}}},
                        AllColumnsFrom {sourceTableName = "table2"}],
                    maybeFromTable = Just (
                        InnerJoin {
                            leftJoinTable = TableIdentifier {tableName = "table1", maybeTableAlias = Nothing},
                            rightJoinTable = TableIdentifier {tableName = "table2", maybeTableAlias = Nothing},
                            onCondition = FunctionExpression {
                                sqlFunction = SQLFunction {functionName = "=", minArgCount = 2, argCountIsFixed = True},
                                functionArguments = [
                                    ColumnExpression {column = ColumnIdentifier {maybeTableName = Just "table1", columnId = "col1"}},
                                    ColumnExpression {column = ColumnIdentifier {maybeTableName = Just "table2", columnId = "col1"}}]},
                            maybeTableAlias = Nothing}),
                    maybeWhereFilter = Just (
                        FunctionExpression {
                            sqlFunction = SQLFunction {functionName = "<>", minArgCount = 2, argCountIsFixed = True},
                            functionArguments = [
                                FunctionExpression {
                                    sqlFunction = SQLFunction {functionName = "UPPER", minArgCount = 1, argCountIsFixed = True},
                                    functionArguments = [ColumnExpression {column = ColumnIdentifier {maybeTableName = Just "table1", columnId = "col1"}}]},
                                FunctionExpression {
                                    sqlFunction = SQLFunction {functionName = "LOWER", minArgCount = 1, argCountIsFixed = True},
                                    functionArguments = [ColumnExpression {column = ColumnIdentifier {maybeTableName = Just "table1", columnId = "col1"}}]}]}),
                    orderByItems = [OrderByItem {
                        orderExpression = ColumnExpression {column = ColumnIdentifier {maybeTableName = Just "table1", columnId = "firstName"}},
                        orderAscending = True}],
                    maybeGroupByHaving = Nothing}
        stmt3_1Txt =
            "select table1.col1, table2.* " ++
            "from table1 join table2 on table1.col1 = table2.col1 " ++
            "where upper(table1.col1)<>lower(table1.col1) order by table1.firstName asc"
        stmt3_2Txt =
            "select table1.col1, table2.* " ++
            "from table1 join table2 on table1.col1 = table2.col1 " ++
            "where upper(table1.col1)<>lower(table1.col1) order by table1.firstName"
        stmt3_3Txt =
            "select table1.col1, table2.* " ++
            "from table1 join table2 on table1.col1 = table2.col1 " ++
            "where upper (table1.col1) <> lower ( table1.col1 ) order by  table1.firstName ascending"
        
        -- test statement 4
        stmt4 = SelectStatement {
                    columnSelections = [
                        ExpressionColumn {expression = ColumnExpression {column = ColumnIdentifier {maybeTableName = Just "table1", columnId = "col1"}}},
                        AllColumnsFrom {sourceTableName = "table2"}],
                    maybeFromTable = Just (
                        InnerJoin {
                            leftJoinTable = TableIdentifier {tableName = "table1", maybeTableAlias = Nothing},
                            rightJoinTable = TableIdentifier {tableName = "table2", maybeTableAlias = Nothing},
                            onCondition = FunctionExpression {
                                sqlFunction = SQLFunction {functionName = "=", minArgCount = 2, argCountIsFixed = True},
                                functionArguments = [
                                    ColumnExpression {column = ColumnIdentifier {maybeTableName = Just "table1", columnId = "col1"}},
                                    ColumnExpression {column = ColumnIdentifier {maybeTableName = Just "table2", columnId = "col1"}}]},
                            maybeTableAlias = Nothing}),
                    maybeWhereFilter = Just (
                        FunctionExpression {
                            sqlFunction = SQLFunction {functionName = "<>", minArgCount = 2, argCountIsFixed = True},
                            functionArguments = [
                                FunctionExpression {
                                    sqlFunction = SQLFunction {functionName = "UPPER", minArgCount = 1, argCountIsFixed = True},
                                    functionArguments = [ColumnExpression {column = ColumnIdentifier {maybeTableName = Just "table1", columnId = "col1"}}]},
                                FunctionExpression {
                                    sqlFunction = SQLFunction {functionName = "LOWER", minArgCount = 1, argCountIsFixed = True},
                                    functionArguments = [ColumnExpression {column = ColumnIdentifier {maybeTableName = Just "table1", columnId = "col1"}}]}]}),
                    orderByItems = [OrderByItem {
                        orderExpression = ColumnExpression {column = ColumnIdentifier {maybeTableName = Just "table1", columnId = "firstName"}},
                        orderAscending = False}],
                    maybeGroupByHaving = Nothing}
        stmt4_1Txt =
            "select table1.col1, table2.* " ++
            "from table1 join table2 on table1.col1 = table2.col1 " ++
            "where upper (table1.col1) <> lower ( table1.col1 ) order by  table1.firstName descending"
        stmt4_2Txt =
            "select table1.col1, table2.* " ++
            "from table1 join table2 on table1.col1 = table2.col1 " ++
            "where upper (table1.col1) <> lower ( table1.col1 ) order by  table1.firstName DESCENDING"
        stmt4_3Txt =
            "select table1.col1, table2.* " ++
            "from table1 join table2 on table1.col1 = table2.col1 " ++
            "where upper (table1.col1) <> lower ( table1.col1 ) order by  table1.firstName desc"
        stmt4_4Txt =
            "select table1.col1, table2.* " ++
            "from table1 join table2 on table1.col1 = table2.col1 " ++
            "where upper (table1.col1) <> lower ( table1.col1 ) order by  table1.firstName DESC"
    
    testSqlSelect stmt1 stmt1_1Txt
    testSqlSelect stmt1 stmt1_2Txt
    
    testSqlSelect stmt2 stmt2_1Txt
    testSqlSelect stmt2 stmt2_2Txt
    
    testSqlSelect stmt3 stmt3_1Txt
    testSqlSelect stmt3 stmt3_2Txt
    testSqlSelect stmt3 stmt3_3Txt

    testSqlSelect stmt4 stmt4_1Txt
    testSqlSelect stmt4 stmt4_2Txt
    testSqlSelect stmt4 stmt4_3Txt
    testSqlSelect stmt4 stmt4_4Txt

testSqlSelect :: SelectStatement -> String -> IO ()
testSqlSelect expectedResult selectStatementText = do
    let stmtParseResult = parse (withTrailing eof parseSelectStatement) "" selectStatementText
        colNums = take (length selectStatementText) ([1 .. 9] ++ cycle [0 .. 9])
    putStrLn ""
    putStrLn "Testing:"
    putStrLn $ concat (map show colNums)
    putStrLn selectStatementText
    case stmtParseResult of
        Left errMsg -> error $ show errMsg
        Right selectStatement ->
            if selectStatement == expectedResult
                then
                    putStrLn "Success"
                else
                    error $ "\n" ++ (show selectStatement) ++ "\nNOT EQUAL TO\n" ++ (show expectedResult)

universal-binary-0.1

module Main where
    
import Distribution.Simple
import System.Cmd(system)

main = defaultMainWithHooks $ simpleUserHooks { runTests = runTests_ }

runTests_ a b pd lb = system "runhaskell -i./src ./tests/Test.hs" >> return ()

vintage-basic-1.0.1

#!/usr/local/bin/runhaskell

import Distribution.Simple
import Distribution.PackageDescription (PackageDescription)
import Distribution.Simple.LocalBuildInfo (LocalBuildInfo)
import System.Cmd (system)
import Distribution.Simple.LocalBuildInfo
import System.Directory (removeFile)

main = defaultMainWithHooks (simpleUserHooks {runTests = runAllTests})

runAllTests :: Args -> Bool -> PackageDescription -> LocalBuildInfo -> IO ()
runAllTests a b pd lb = do
    system "runhaskell run_tests.hs"
    removeFile "test_driver.hs"
    return ()

WebBits-Html-1.0.1

#!/usr/bin/env runhaskell
import Distribution.Simple
import qualified Data.List as L
import System.Directory
import qualified Data.Char as Ch
import System.Process (runCommand,waitForProcess)

isHaskellFile file = ".lhs" `L.isSuffixOf` file || ".hs" `L.isSuffixOf` file

moduleName file = L.takeWhile  (/= '.') file

isRequested :: [String] -> String -> Bool
isRequested requestedTests test = 
  (map Ch.toLower test) `elem` (map (map Ch.toLower) requestedTests)

testMain args _ _ _ = do
  files <- getDirectoryContents "tests"
  let testFiles = filter isHaskellFile files
  let testModules = if null args
                      then map moduleName testFiles
                      else filter (isRequested args) (map moduleName testFiles)
  let testFuncs = map (++ ".main") testModules
  let testExpr = "sequence [ " ++ concat (L.intersperse "," testFuncs) ++ 
                 " ] >>= \\cases -> runTestTT (TestList cases)"
  let moduleLine = concat (L.intersperse " " testModules)
  let cmd = "cd tests && ghc  -XNoMonomorphismRestriction -fglasgow-exts " ++
            "-package HUnit -package parsec-2.1.0.1 -i:../src -e \"" ++ 
            testExpr ++ " >> return ()\" " ++ moduleLine
  putStrLn "Testing command is:"
  putStrLn cmd
  putStrLn "\nLoading tests..."
  handle <- runCommand cmd
  waitForProcess handle
  putStrLn "Testing complete.  Errors reported above (if any)."


main = defaultMainWithHooks (simpleUserHooks { runTests = testMain })

WebBits-1.0

#!/usr/bin/env runhaskell
import Distribution.Simple
import qualified Data.List as L
import System.Directory
import qualified Data.Char as Ch
import System.Process (runCommand,waitForProcess)

isHaskellFile file = ".lhs" `L.isSuffixOf` file || ".hs" `L.isSuffixOf` file

moduleName file = L.takeWhile  (/= '.') file

isRequested :: [String] -> String -> Bool
isRequested requestedTests test = 
  (map Ch.toLower test) `elem` (map (map Ch.toLower) requestedTests)

testMain args _ _ _ = do
  files <- getDirectoryContents "tests"
  let testFiles = filter isHaskellFile files
  let testModules = if null args
                      then map moduleName testFiles
                      else filter (isRequested args) (map moduleName testFiles)
  let testFuncs = map (++ ".main") testModules
  let testExpr = "sequence [ " ++ concat (L.intersperse "," testFuncs) ++ 
                 " ] >>= \\cases -> runTestTT (TestList cases)"
  let moduleLine = concat (L.intersperse " " testModules)
  let cmd = "cd tests && ghc  -XNoMonomorphismRestriction -fglasgow-exts " ++
            "-package HUnit -package parsec-2.1.0.1 -i:../src -e \"" ++ 
            testExpr ++ " >> return ()\" " ++ moduleLine
  putStrLn "Testing command is:"
  putStrLn cmd
  putStrLn "\nLoading tests..."
  handle <- runCommand cmd
  waitForProcess handle
  putStrLn "Testing complete.  Errors reported above (if any)."


main = defaultMainWithHooks (simpleUserHooks { runTests = testMain })

xformat-0.1

#! /usr/bin/env runhaskell

\begin{code}
{-# OPTIONS -Wall #-}

-----------------------------------------------------------------------------
-- |
-- Module      :  Setup
-- Copyright   :  (c) 2009 Sean Leather
-- License     :  BSD3
--
-- Maintainer  :  leather@cs.uu.nl
-----------------------------------------------------------------------------

module Main (main) where

import System.Cmd
  ( system
  )

import System.FilePath
  ( ()
  )

import Distribution.Simple
  ( defaultMainWithHooks
  , simpleUserHooks
  , UserHooks(runTests)
  , Args
  )

import Distribution.Simple.LocalBuildInfo
  ( LocalBuildInfo
  )

import Distribution.PackageDescription
  ( PackageDescription
  )

main :: IO ()
main = defaultMainWithHooks hooks
  where
    hooks = simpleUserHooks
            { runTests    = runTests'
            }

-- 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

\end{code}


zoneinfo-0.5

#!/usr/bin/env runhaskell
import Distribution.Simple
import System.Cmd
import System.Directory
import System.Exit
import System.FilePath.Posix

make = "ghc --make -fglasgow-exts -odir dist/build -hidir dist/build -idist/build:src Tests.hs -o tests -Ldist/build -lHSzoneinfo-0.5"

tests :: IO String
tests = do
    cd <- getCurrentDirectory
    return $ joinPath $ (++) (splitPath cd) ["tests"]

main :: IO ()
main =
    defaultMainWithHooks (autoconfUserHooks { runTests = quickCheck })
  where
    quickCheck _ _ _ _ = do
        status <- system make
        case status of
          ExitSuccess -> tests >>= system >> return ()
          _ -> return ()