-----------------------------------------------------------------------------
-- |
-- Module      :  Distribution.Simple.Build.Macros
-- Copyright   :  Isaac Jones 2003-2005,
--                Ross Paterson 2006,
--                Duncan Coutts 2007-2008
--
-- Maintainer  :  cabal-devel@haskell.org
-- Portability :  portable
--
-- Generating the Paths_pkgname module.
--
-- This is a module that Cabal generates for the benefit of packages. It
-- enables them to find their version number and find any installed data files
-- at runtime. This code should probably be split off into another module.
--
module Distribution.Simple.Build.PathsModule (
    generatePathsModule, pkgPathEnvVar
  ) where

import Distribution.Compat.Prelude
import Prelude ()

import Distribution.Package
import Distribution.PackageDescription
import Distribution.Simple.Compiler
import Distribution.Simple.LocalBuildInfo
import Distribution.Simple.Utils          (shortRelativePath)
import Distribution.System
import Distribution.Version

import qualified Distribution.Simple.Build.PathsModule.Z as Z

-- ------------------------------------------------------------
-- * Building Paths_<pkg>.hs
-- ------------------------------------------------------------

generatePathsModule :: PackageDescription -> LocalBuildInfo -> ComponentLocalBuildInfo -> String
generatePathsModule :: PackageDescription
-> LocalBuildInfo -> ComponentLocalBuildInfo -> String
generatePathsModule PackageDescription
pkg_descr LocalBuildInfo
lbi ComponentLocalBuildInfo
clbi = Z -> String
Z.render Z :: PackageName
-> String
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> String
-> String
-> String
-> String
-> String
-> String
-> String
-> (Bool -> Bool)
-> (PackageName -> String)
-> Z
Z.Z
    { zPackageName :: PackageName
Z.zPackageName                = PackageDescription -> PackageName
forall pkg. Package pkg => pkg -> PackageName
packageName PackageDescription
pkg_descr
    , zVersionDigits :: String
Z.zVersionDigits              = [Int] -> String
forall a. Show a => a -> String
show ([Int] -> String) -> [Int] -> String
forall a b. (a -> b) -> a -> b
$ Version -> [Int]
versionNumbers (Version -> [Int]) -> Version -> [Int]
forall a b. (a -> b) -> a -> b
$ PackageDescription -> Version
forall pkg. Package pkg => pkg -> Version
packageVersion PackageDescription
pkg_descr
    , zSupportsCpp :: Bool
Z.zSupportsCpp                = Bool
supports_cpp
    , zSupportsNoRebindableSyntax :: Bool
Z.zSupportsNoRebindableSyntax = Bool
supports_rebindable_syntax
    , zAbsolute :: Bool
Z.zAbsolute                   = Bool
absolute
    , zRelocatable :: Bool
Z.zRelocatable                = LocalBuildInfo -> Bool
relocatable LocalBuildInfo
lbi
    , zIsWindows :: Bool
Z.zIsWindows                  = Bool
isWindows
    , zIsI386 :: Bool
Z.zIsI386                     = Arch
buildArch Arch -> Arch -> Bool
forall a. Eq a => a -> a -> Bool
== Arch
I386
    , zIsX8664 :: Bool
Z.zIsX8664                    = Arch
buildArch Arch -> Arch -> Bool
forall a. Eq a => a -> a -> Bool
== Arch
X86_64
    , zNot :: Bool -> Bool
Z.zNot                        = Bool -> Bool
not
    , zManglePkgName :: PackageName -> String
Z.zManglePkgName              = PackageName -> String
showPkgName

    , zPrefix :: String
Z.zPrefix     = String -> String
forall a. Show a => a -> String
show String
flat_prefix
    , zBindir :: String
Z.zBindir     = String
zBindir
    , zLibdir :: String
Z.zLibdir     = String
zLibdir
    , zDynlibdir :: String
Z.zDynlibdir  = String
zDynlibdir
    , zDatadir :: String
Z.zDatadir    = String
zDatadir
    , zLibexecdir :: String
Z.zLibexecdir = String
zLibexecdir
    , zSysconfdir :: String
Z.zSysconfdir = String
zSysconfdir
    }
  where
    supports_cpp :: Bool
supports_cpp                 = Bool
supports_language_pragma
    supports_rebindable_syntax :: Bool
supports_rebindable_syntax   = Version -> Bool
ghc_newer_than ([Int] -> Version
mkVersion [Int
7,Int
0,Int
1])
    supports_language_pragma :: Bool
supports_language_pragma     = Version -> Bool
ghc_newer_than ([Int] -> Version
mkVersion [Int
6,Int
6,Int
1])

    ghc_newer_than :: Version -> Bool
ghc_newer_than Version
minVersion =
        case CompilerFlavor -> Compiler -> Maybe Version
compilerCompatVersion CompilerFlavor
GHC (LocalBuildInfo -> Compiler
compiler LocalBuildInfo
lbi) of
            Maybe Version
Nothing      -> Bool
False
            Just Version
version -> Version
version Version -> VersionRange -> Bool
`withinRange` Version -> VersionRange
orLaterVersion Version
minVersion

    -- In several cases we cannot make relocatable installations
    absolute :: Bool
absolute =
         PackageDescription -> Bool
hasLibs PackageDescription
pkg_descr        -- we can only make progs relocatable
      Bool -> Bool -> Bool
|| Maybe String -> Bool
forall a. Maybe a -> Bool
isNothing Maybe String
flat_bindirrel -- if the bin dir is an absolute path
      Bool -> Bool -> Bool
|| Bool -> Bool
not (CompilerFlavor -> Bool
supportsRelocatableProgs (Compiler -> CompilerFlavor
compilerFlavor (LocalBuildInfo -> Compiler
compiler LocalBuildInfo
lbi)))

    -- TODO: Here, and with zIsI386 & zIs8664 we should use TARGET platform
    isWindows :: Bool
isWindows = case OS
buildOS of
        OS
Windows   -> Bool
True
        OS
_         -> Bool
False

    supportsRelocatableProgs :: CompilerFlavor -> Bool
supportsRelocatableProgs CompilerFlavor
GHC   = Bool
isWindows
    supportsRelocatableProgs CompilerFlavor
GHCJS = Bool
isWindows
    supportsRelocatableProgs CompilerFlavor
_     = Bool
False

    cid :: UnitId
cid = ComponentLocalBuildInfo -> UnitId
componentUnitId ComponentLocalBuildInfo
clbi

    InstallDirs
        { bindir :: forall dir. InstallDirs dir -> dir
bindir     = String
flat_bindir
        , libdir :: forall dir. InstallDirs dir -> dir
libdir     = String
flat_libdir
        , dynlibdir :: forall dir. InstallDirs dir -> dir
dynlibdir  = String
flat_dynlibdir
        , datadir :: forall dir. InstallDirs dir -> dir
datadir    = String
flat_datadir
        , libexecdir :: forall dir. InstallDirs dir -> dir
libexecdir = String
flat_libexecdir
        , sysconfdir :: forall dir. InstallDirs dir -> dir
sysconfdir = String
flat_sysconfdir
        , prefix :: forall dir. InstallDirs dir -> dir
prefix     = String
flat_prefix
        } = PackageDescription
-> LocalBuildInfo -> UnitId -> CopyDest -> InstallDirs String
absoluteInstallCommandDirs PackageDescription
pkg_descr LocalBuildInfo
lbi UnitId
cid CopyDest
NoCopyDest

    InstallDirs
        { bindir :: forall dir. InstallDirs dir -> dir
bindir     = Maybe String
flat_bindirrel
        , libdir :: forall dir. InstallDirs dir -> dir
libdir     = Maybe String
flat_libdirrel
        , dynlibdir :: forall dir. InstallDirs dir -> dir
dynlibdir  = Maybe String
flat_dynlibdirrel
        , datadir :: forall dir. InstallDirs dir -> dir
datadir    = Maybe String
flat_datadirrel
        , libexecdir :: forall dir. InstallDirs dir -> dir
libexecdir = Maybe String
flat_libexecdirrel
        , sysconfdir :: forall dir. InstallDirs dir -> dir
sysconfdir = Maybe String
flat_sysconfdirrel
        } = PackageId -> LocalBuildInfo -> UnitId -> InstallDirs (Maybe String)
prefixRelativeComponentInstallDirs (PackageDescription -> PackageId
forall pkg. Package pkg => pkg -> PackageId
packageId PackageDescription
pkg_descr) LocalBuildInfo
lbi UnitId
cid

    zBindir, zLibdir, zDynlibdir, zDatadir, zLibexecdir, zSysconfdir :: String
    (String
zBindir, String
zLibdir, String
zDynlibdir, String
zDatadir, String
zLibexecdir, String
zSysconfdir)
        | LocalBuildInfo -> Bool
relocatable LocalBuildInfo
lbi =
            ( String -> String
forall a. Show a => a -> String
show String
flat_bindir_reloc
            , String -> String
forall a. Show a => a -> String
show String
flat_libdir_reloc
            , String -> String
forall a. Show a => a -> String
show String
flat_dynlibdir_reloc
            , String -> String
forall a. Show a => a -> String
show String
flat_datadir_reloc
            , String -> String
forall a. Show a => a -> String
show String
flat_libexecdir_reloc
            , String -> String
forall a. Show a => a -> String
show String
flat_sysconfdir_reloc
            )
        | Bool
absolute        =
            ( String -> String
forall a. Show a => a -> String
show String
flat_bindir
            , String -> String
forall a. Show a => a -> String
show String
flat_libdir
            , String -> String
forall a. Show a => a -> String
show String
flat_dynlibdir
            , String -> String
forall a. Show a => a -> String
show String
flat_datadir
            , String -> String
forall a. Show a => a -> String
show String
flat_libexecdir
            , String -> String
forall a. Show a => a -> String
show String
flat_sysconfdir
            )
        | Bool
isWindows       =
            ( String
"maybe (error \"PathsModule.generate\") id (" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Maybe String -> String
forall a. Show a => a -> String
show Maybe String
flat_bindirrel String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
            , String -> Maybe String -> String
mkGetDir String
flat_libdir Maybe String
flat_libdirrel
            , String -> Maybe String -> String
mkGetDir String
flat_dynlibdir Maybe String
flat_dynlibdirrel
            , String -> Maybe String -> String
mkGetDir String
flat_datadir Maybe String
flat_datadirrel
            , String -> Maybe String -> String
mkGetDir String
flat_libexecdir Maybe String
flat_libexecdirrel
            , String -> Maybe String -> String
mkGetDir String
flat_sysconfdir Maybe String
flat_sysconfdirrel
            )
        | Bool
otherwise       =
            String -> (String, String, String, String, String, String)
forall a. HasCallStack => String -> a
error String
"panic! generatePathsModule: should never happen"

    mkGetDir :: FilePath -> Maybe FilePath -> String
    mkGetDir :: String -> Maybe String -> String
mkGetDir String
_   (Just String
dirrel) = String
"getPrefixDirRel " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
dirrel
    mkGetDir String
dir Maybe String
Nothing       = String
"return " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
dir

    flat_bindir_reloc :: String
flat_bindir_reloc     = String -> String -> String
shortRelativePath String
flat_prefix String
flat_bindir
    flat_libdir_reloc :: String
flat_libdir_reloc     = String -> String -> String
shortRelativePath String
flat_prefix String
flat_libdir
    flat_dynlibdir_reloc :: String
flat_dynlibdir_reloc  = String -> String -> String
shortRelativePath String
flat_prefix String
flat_dynlibdir
    flat_datadir_reloc :: String
flat_datadir_reloc    = String -> String -> String
shortRelativePath String
flat_prefix String
flat_datadir
    flat_libexecdir_reloc :: String
flat_libexecdir_reloc = String -> String -> String
shortRelativePath String
flat_prefix String
flat_libexecdir
    flat_sysconfdir_reloc :: String
flat_sysconfdir_reloc = String -> String -> String
shortRelativePath String
flat_prefix String
flat_sysconfdir

-- | Generates the name of the environment variable controlling the path
-- component of interest.
--
-- Note: The format of these strings is part of Cabal's public API;
-- changing this function constitutes a *backwards-compatibility* break.
pkgPathEnvVar
    :: PackageDescription
    -> String     -- ^ path component; one of \"bindir\", \"libdir\", -- \"datadir\", \"libexecdir\", or \"sysconfdir\"
    -> String     -- ^ environment variable name
pkgPathEnvVar :: PackageDescription -> String -> String
pkgPathEnvVar PackageDescription
pkg_descr String
var =
    PackageName -> String
showPkgName (PackageDescription -> PackageName
forall pkg. Package pkg => pkg -> PackageName
packageName PackageDescription
pkg_descr) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"_" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
var

showPkgName :: PackageName -> String
showPkgName :: PackageName -> String
showPkgName = (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
fixchar (String -> String)
-> (PackageName -> String) -> PackageName -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageName -> String
unPackageName

fixchar :: Char -> Char
fixchar :: Char -> Char
fixchar Char
'-' = Char
'_'
fixchar Char
c   = Char
c