PageRenderTime 15ms CodeModel.GetById 1ms app.highlight 9ms RepoModel.GetById 2ms app.codeStats 0ms

/Setup.hs

http://github.com/hdbc/hdbc-postgresql
Haskell | 69 lines | 49 code | 15 blank | 5 comment | 0 complexity | 1d9fb93bbfd0cf7523a6a511ff85fbc1 MD5 | raw file
 1#!/usr/bin/env runhaskell
 2{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}
 3
 4import Distribution.Simple
 5import Distribution.PackageDescription
 6import Distribution.Version
 7
 8import Distribution.Simple.LocalBuildInfo
 9import Distribution.Simple.Program
10import Distribution.Verbosity
11
12import Data.Char (isSpace)
13import Data.List (dropWhile,reverse)
14import Data.String (fromString)
15
16import Control.Monad
17
18main = defaultMainWithHooks simpleUserHooks {
19  hookedPrograms = [pgconfigProgram],
20
21  confHook = \pkg flags -> do
22    lbi <- confHook simpleUserHooks pkg flags
23    bi <- psqlBuildInfo lbi
24    
25    return lbi {
26      localPkgDescr = updatePackageDescription
27                        (Just bi, [(fromString "runtests", bi)]) (localPkgDescr lbi)
28    } 
29}
30
31-- 'ConstOrId' is a @Cabal-1.16@ vs @Cabal-1.18@ compatibility hack,
32-- 'programFindLocation' has a new (unused in this case)
33-- parameter. 'ConstOrId' adds this parameter when types say it is
34-- mandatory.
35class FindProgramLocation a b where
36    constOrId :: a -> b
37
38instance FindProgramLocation (IO (Maybe FilePath)) (IO (Maybe FilePath)) where
39    constOrId = id
40
41instance FindProgramLocation (IO (Maybe FilePath)) (ProgramSearchPath -> IO (Maybe FilePath)) where
42    constOrId = const
43
44instance FindProgramLocation (IO (Maybe FilePath)) (ProgramSearchPath -> IO (Maybe (FilePath, [FilePath]))) where
45    constOrId x = liftM (fmap (\x -> (x, []))) . const x
46
47pgconfigProgram = (simpleProgram "pgconfig or pg_config") {
48    programFindLocation = \verbosity searchPath -> do
49      pgconfig  <- findProgramOnSearchPath verbosity searchPath "pgconfig"
50      pg_config <- findProgramOnSearchPath verbosity searchPath "pg_config"
51      return (pgconfig `mplus` pg_config)
52  }
53
54psqlBuildInfo :: LocalBuildInfo -> IO BuildInfo
55psqlBuildInfo lbi = do
56  (pgconfigProg, _) <- requireProgram verbosity
57                         pgconfigProgram (withPrograms lbi)
58  let pgconfig = getProgramOutput verbosity pgconfigProg
59
60  incDir <- pgconfig ["--includedir"]
61  libDir <- pgconfig ["--libdir"]
62
63  return emptyBuildInfo {
64    extraLibDirs = [strip libDir],
65    includeDirs  = [strip incDir]
66  }
67  where
68    verbosity = normal -- honestly, this is a hack
69    strip x = dropWhile isSpace $ reverse $ dropWhile isSpace $ reverse x