    {-# OPTIONS -cpp #-}
    -----------------------------------------------------------------------------
    -- |
    -- Module      :  Distribution.Simple.GHC.PackageConfig
    -- Copyright   :  (c) The University of Glasgow 2004
    --
    -- Maintainer  :  libraries@haskell.org
    -- Stability   :  alpha
    -- Portability :  portable
    --
    -- Explanation: Performs registration for GHC.  Specific to
    -- ghc-pkg. Creates a GHC package config file.  See also
    -- 'Distribution.Simple.GHC.build', etc.

    module Distribution.Simple.GHC.PackageConfig (
    	GHCPackageConfig(..),
    	mkGHCPackageConfig,
    	defaultGHCPackageConfig,
    	showGHCPackageConfig,

            localPackageConfig, maybeCreateLocalPackageConfig,
            canWriteLocalPackageConfig, canReadLocalPackageConfig
      ) where

    import Distribution.PackageDescription (PackageDescription(..), BuildInfo(..), Library(..))
    import Distribution.Package (PackageIdentifier(..), showPackageId)
    import Distribution.Simple.LocalBuildInfo (LocalBuildInfo(..), absoluteInstallDirs)
    import Distribution.Simple.InstallDirs (InstallDirs(..))
    import Distribution.Simple.Setup (CopyDest(..))

    #ifndef __NHC__
    import Control.Exception (try)
    #else
    import IO (try)
    #endif
    import Control.Monad(unless)
    import Text.PrettyPrint.HughesPJ
    import System.Directory (doesFileExist, getPermissions, Permissions (..))
    import System.FilePath ((</>))
    import Distribution.Compat.Directory (getHomeDirectory)

    -- |Where ghc versions < 6.3 keeps the --user files.
    -- |return the file, whether it exists, and whether it's readable

    localPackageConfig :: IO FilePath
    localPackageConfig = do u <- getHomeDirectory
                            return $ (u </> ".ghc-packages")

    -- |If the package file doesn't exist, we should try to create it.  If
    -- it already exists, do nothing and return true.  This does not take
    -- into account whether it is readable or writeable.
    maybeCreateLocalPackageConfig :: IO Bool  -- ^success?
    maybeCreateLocalPackageConfig
        = do f <- localPackageConfig
             exists <- doesFileExist f
             unless exists $ (try (writeFile f "[]\n") >> return ())
             doesFileExist f

    -- |Helper function for canReadPackageConfig and canWritePackageConfig
    checkPermission :: (Permissions -> Bool) -> IO Bool
    checkPermission perm
        = do f <- localPackageConfig
             exists <- doesFileExist f
             if exists
                then getPermissions f >>= (return . perm)
                else return False

    -- |Check for read permission on the localPackageConfig
    canReadLocalPackageConfig :: IO Bool
    canReadLocalPackageConfig = checkPermission readable

    -- |Check for write permission on the localPackageConfig
    canWriteLocalPackageConfig :: IO Bool
    canWriteLocalPackageConfig = checkPermission writable

    -- -----------------------------------------------------------------------------
    -- GHC 6.2 PackageConfig type

    -- Until GHC supports the InstalledPackageInfo type above, we use its
    -- existing PackagConfig type.

    mkGHCPackageConfig :: PackageDescription -> LocalBuildInfo -> GHCPackageConfig
    mkGHCPackageConfig pkg_descr lbi
      = defaultGHCPackageConfig {
    	name	        = pkgName pkg,
    	auto	        = True,
    	import_dirs     = [libdir installDirs],
    	library_dirs    = libdir installDirs
                            : maybe [] (extraLibDirs . libBuildInfo) lib,
    	hs_libraries    = ["HS"++(showPackageId (package pkg_descr))],
    	extra_libraries = maybe [] (extraLibs   . libBuildInfo) lib,
    	include_dirs    = maybe [] (includeDirs . libBuildInfo) lib,
    	c_includes      = maybe [] (includes    . libBuildInfo) lib,
    	package_deps    = map pkgName (packageDeps lbi)
        }
     where
       pkg = package pkg_descr
       lib = library pkg_descr
       installDirs = absoluteInstallDirs pkg_descr lbi NoCopyDest

    data GHCPackageConfig
       = GHCPackage {
    	name            :: String,
    	auto		:: Bool,
    	import_dirs     :: [String],
    	source_dirs     :: [String],
    	library_dirs    :: [String],
    	hs_libraries    :: [String],
    	extra_libraries :: [String],
    	include_dirs    :: [String],
    	c_includes      :: [String],
    	package_deps    :: [String],
    	extra_ghc_opts  :: [String],
    	extra_cc_opts   :: [String],
    	extra_ld_opts   :: [String],
    	framework_dirs  :: [String], -- ignored everywhere but on Darwin/MacOS X
    	extra_frameworks:: [String]  -- ignored everywhere but on Darwin/MacOS X
         }

    defaultGHCPackageConfig :: GHCPackageConfig
    defaultGHCPackageConfig
       = GHCPackage {
    	name = error "defaultPackage",
    	auto = False,
    	import_dirs     = [],
    	source_dirs     = [],
    	library_dirs    = [],
    	hs_libraries    = [],
    	extra_libraries = [],
    	include_dirs    = [],
    	c_includes      = [],
    	package_deps    = [],
    	extra_ghc_opts  = [],
    	extra_cc_opts   = [],
    	extra_ld_opts   = [],
    	framework_dirs  = [],
    	extra_frameworks= []
        }

    -- ---------------------------------------------------------------------------
    -- Pretty printing package info

    showGHCPackageConfig :: GHCPackageConfig -> String
    showGHCPackageConfig pkg = render $
       text "Package" $$ nest 3 (braces (
          sep (punctuate comma [
             text "name = " <> text (show (name pkg)),
    	 text "auto = " <> text (show (auto pkg)),
             dumpField "import_dirs"     (import_dirs     pkg),
             dumpField "source_dirs"     (source_dirs     pkg),
             dumpField "library_dirs"    (library_dirs    pkg),
             dumpField "hs_libraries"    (hs_libraries    pkg),
             dumpField "extra_libraries" (extra_libraries pkg),
             dumpField "include_dirs"    (include_dirs    pkg),
             dumpField "c_includes"      (c_includes      pkg),
             dumpField "package_deps"    (package_deps    pkg),
             dumpField "extra_ghc_opts"  (extra_ghc_opts  pkg),
             dumpField "extra_cc_opts"   (extra_cc_opts   pkg),
             dumpField "extra_ld_opts"   (extra_ld_opts   pkg),
             dumpField "framework_dirs"  (framework_dirs   pkg),
             dumpField "extra_frameworks"(extra_frameworks pkg)
          ])))

    dumpField :: String -> [String] -> Doc
    dumpField name' val = hang (text name' <+> equals) 2  (dumpFieldContents val)

    dumpFieldContents :: [String] -> Doc
    dumpFieldContents val = brackets (sep (punctuate comma (map (text . show) val)))