Setup.hs

   1 #!/usr/bin/env runghc
   2
   3 import Distribution.Simple
   4 main = defaultMain
   5
   6 {-
   7 import Data.Maybe
   8 import Distribution.PackageDescription
   9 import Distribution.Setup
  10 import Distribution.Simple
  11 import Distribution.Simple.Configure
  12 import Distribution.Simple.LocalBuildInfo
  13 import System.IO
  14 import System.Exit
  15 import System.Directory
  16 import System.Process
  17 import Control.Monad
  18 import Control.Exception
  19
  20 buildInfoName = "Kirschbaum.buildinfo"
  21 cgiName = "Kirschbaum.cgi"
  22
  23 main = defaultMainWithHooks defaultUserHooks {preConf = preConf, postConf = postConf}
  24     where
  25       preConf :: [String] -> ConfigFlags -> IO HookedBuildInfo
  26       preConf args flags
  27           = do try (removeFile buildInfoName)
  28                return emptyHookedBuildInfo
  29       postConf :: [String] -> ConfigFlags -> PackageDescription -> LocalBuildInfo -> IO ExitCode
  30       postConf args flags _ localbuildinfo
  31           = do binfo <- pkgConfigBuildInfo (configVerbose flags)
  32                let default_binfo = emptyBuildInfo {extraLibs = ["xml2", "xslt", "exslt"]}
  33                writeHookedBuildInfo buildInfoName (Just emptyBuildInfo,
  34                                                    [(cgiName, fromMaybe default_binfo binfo)])
  35                return ExitSuccess
  36
  37
  38 message :: String -> IO ()
  39 message s = putStrLn $ "configure: " ++ s
  40
  41 rawSystemGrabOutput :: Int -> FilePath -> [String] -> IO String
  42 rawSystemGrabOutput verbose path args
  43     = do when (verbose > 0) $
  44               putStrLn (path ++ concatMap (' ':) args)
  45          (inp,out,err,pid) <- runInteractiveProcess path args Nothing Nothing
  46          exitCode <- waitForProcess pid
  47          if exitCode /= ExitSuccess then
  48              do errMsg <- hGetContents err
  49                 hPutStr stderr errMsg
  50                 exitWith exitCode else
  51              return ()
  52          hClose inp
  53          hClose err
  54          hGetContents out
  55
  56 {-
  57 mergeBuildInfo :: BuildInfo -> BuildInfo -> BuildInfo
  58 mergeBuildInfo b1 b2 = BuildInfo {
  59                          buildable    = buildable    b1 || buildable    b2,
  60                          ccOptions    = ccOptions    b1 ++ ccOptions    b2,
  61                          ldOptions    = ldOptions    b1 ++ ldOptions    b2,
  62                          frameworks   = frameworks   b1 ++ frameworks   b2,
  63                          cSources     = cSources     b1 ++ cSources     b2,
  64                          hsSourceDirs = hsSourceDirs b1 ++ hsSourceDirs b2,
  65                          otherModules = otherModules b1 ++ otherModules b2,
  66                          extensions   = extensions   b1 ++ extensions   b2,
  67                          extraLibs    = extraLibs    b1 ++ extraLibs    b2,
  68                          extraLibDirs = extraLibDirs b1 ++ extraLibDirs b2,
  69                          includeDirs  = includeDirs  b1 ++ includeDirs  b2,
  70                          includes     = includes     b1 ++ includes     b2,
  71                          installIncludes = installIncludes b1 ++ installIncludes b2,
  72                          options      = options      b1 ++ options      b2,
  73                          ghcProfOptions = ghcProfOptions b1 ++ ghcProfOptions b2
  74                        }
  75
  76 libXml2ConfigBuildInfo :: Int -> IO (Maybe BuildInfo)
  77 libXml2ConfigBuildInfo verbose
  78     = do mb_libxml2_config_path <- findProgram "xml2-config" Nothing
  79          case mb_libxml2_config_path
  80               of Just libxml2_config_path
  81                       -> do message "configuring libxml2 library"
  82                             res <- rawSystemGrabOutput verbose libxml2_config_path ["--libs"]
  83                             let (lib_dirs, libs, ld_opts) = splitLibsFlags (words res)
  84                             res <- rawSystemGrabOutput verbose libxml2_config_path ["--cflags"]
  85                             let (inc_dirs, cc_opts) = splitCFlags (words res)
  86                             let bi = emptyBuildInfo {
  87                                        extraLibDirs = lib_dirs,
  88                                        extraLibs    = libs,
  89                                        ldOptions    = ld_opts,
  90                                        includeDirs  = inc_dirs,
  91                                        ccOptions    = cc_opts
  92                                      }
  93                             return $ Just bi
  94                  Nothing
  95                      -> do message "This package will be built using default settings for libxml2 library"
  96                            return Nothing
  97
  98 libXsltConfigBuildInfo :: Int -> IO (Maybe BuildInfo)
  99 libXsltConfigBuildInfo verbose
 100     = do mb_libxslt_config_path <- findProgram "xslt-config" Nothing
 101          case mb_libxslt_config_path
 102               of Just libxslt_config_path
 103                       -> do message "configuring libxslt library"
 104                             res <- rawSystemGrabOutput verbose libxslt_config_path ["--libs"]
 105                             let (lib_dirs, libs, ld_opts) = splitLibsFlags (words res)
 106                             res <- rawSystemGrabOutput verbose libxslt_config_path ["--cflags"]
 107                             let (inc_dirs, cc_opts) = splitCFlags (words res)
 108                             let bi = emptyBuildInfo {
 109                                        extraLibDirs = lib_dirs,
 110                                        extraLibs    = libs,
 111                                        ldOptions    = ld_opts,
 112                                        includeDirs  = inc_dirs,
 113                                        ccOptions    = cc_opts
 114                                      }
 115                             return $ Just bi
 116                  Nothing
 117                      -> do message "This package will be built using default settings for libxslt library"
 118                            return Nothing
 119 -}
 120
 121 pkgConfigBuildInfo :: Int -> IO (Maybe BuildInfo)
 122 pkgConfigBuildInfo verbose
 123     = do mb_libxslt_config_path <- findProgram "pkg-config" Nothing
 124          case mb_libxslt_config_path
 125               of Just libxslt_config_path
 126                       -> do message "configuring libxml2, libxslt and libexslt library"
 127                             let modules = ["libxml-2.0", "libxslt", "libexslt"]
 128                             res <- rawSystemGrabOutput verbose libxslt_config_path (modules ++ ["--libs"])
 129                             let (lib_dirs, libs, ld_opts) = splitLibsFlags (words res)
 130                             res <- rawSystemGrabOutput verbose libxslt_config_path (modules ++ ["--cflags"])
 131                             let (inc_dirs, cc_opts) = splitCFlags (words res)
 132                             let bi = emptyBuildInfo {
 133                                        extraLibDirs = lib_dirs,
 134                                        extraLibs    = libs,
 135                                        ldOptions    = ld_opts,
 136                                        includeDirs  = inc_dirs,
 137                                        ccOptions    = cc_opts
 138                                      }
 139                             return $ Just bi
 140                  Nothing
 141                      -> do message "This package will be built using default settings for libxslt library"
 142                            return Nothing
 143
 144 splitLibsFlags :: [String] -> ([String], [String], [String])
 145 splitLibsFlags []         = ([], [], [])
 146 splitLibsFlags (arg:args)
 147     = case arg
 148       of ('-':'L':lib_dir) -> let (lib_dirs, libs, ld_opts) = splitLibsFlags args
 149                               in  (lib_dir:lib_dirs, libs, ld_opts)
 150          ('-':'l':lib)     -> let (lib_dirs, libs, ld_opts) = splitLibsFlags args
 151                               in  (lib_dirs, lib:libs, ld_opts)
 152          ld_opt            -> let (lib_dirs, libs, ld_opts) = splitLibsFlags args
 153                               in  (lib_dirs, libs, ld_opt:ld_opts)
 154
 155 splitCFlags :: [String] -> ([String], [String])
 156 splitCFlags []         = ([], [])
 157 splitCFlags (arg:args)
 158     = case arg
 159       of ('-':'I':inc_dir) -> let (inc_dirs, c_opts) = splitCFlags args
 160                               in  (inc_dir:inc_dirs, c_opts)
 161          c_opt             -> let (inc_dirs, c_opts) = splitCFlags args
 162                               in  (inc_dirs, c_opt:c_opts)
 163 -}