htoolkit-cvs

[<kr_...@us...>]

Update of /cvsroot/htoolkit/HSQL/PostgreSQL
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv23927/PostgreSQL

Added Files:
	PostgreSQL.cabal Setup.lhs 
Log Message:
Add PostgreSQL driver


--- NEW FILE: PostgreSQL.cabal ---
name:		 hsql-postgresql
version:	 1.5
license:	 BSD3
author:		 Krasimir Angelov <kr....@gm...>
category:	 Database
description: 	 PostgreSQL driver for HSQL.
exposed-modules: Database.HSQL.PostgreSQL
build-depends: 	 base, hsql
extensions:      ForeignFunctionInterface, CPP
extra-libraries: pq
--- NEW FILE: Setup.lhs ---
#!/usr/bin/runghc

\begin{code}
import Data.Maybe(fromMaybe)
import Distribution.PackageDescription
import Distribution.Setup
import Distribution.Simple
import Distribution.Simple.LocalBuildInfo
import Distribution.Simple.Utils(rawSystemVerbose)
import System.Info
import System.Exit
import System.Directory
import System.Process(runInteractiveProcess, waitForProcess)
import System.IO(hClose, hGetContents, hPutStr, stderr)
import Control.Monad(when)
import Control.Exception(try)

main = defaultMainWithHooks defaultUserHooks{preConf=preConf, postConf=postConf}
  where
    preConf ::  [String] -> ConfigFlags -> IO HookedBuildInfo
    preConf args flags = do
      try (removeFile "PostgreSQL.buildinfo")
      return emptyHookedBuildInfo
    postConf :: [String] -> ConfigFlags -> LocalBuildInfo -> IO ExitCode
    postConf args flags localbuildinfo = do
      mb_bi <- pqConfigBuildInfo (configVerbose flags)
      writeHookedBuildInfo "PostgreSQL.buildinfo" (Just (fromMaybe emptyBuildInfo mb_bi),[])
      return ExitSuccess
\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}
pqConfigBuildInfo :: Int -> IO (Maybe BuildInfo)
pqConfigBuildInfo verbose = 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 verbose pq_config_path ["--libdir"]
       let lib_dirs = words res
       res <- rawSystemGrabOutput verbose pq_config_path ["--includedir"]
       let inc_dirs = words res
       res <- rawSystemGrabOutput verbose pq_config_path ["--includedir-server"]
       let inc_dirs_server = words res
       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
\end{code}