{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RankNTypes #-}

-----------------------------------------------------------------------------
-- |
-- Module      :  Distribution.Simple.InstallDirs
-- Copyright   :  Isaac Jones 2003-2004
-- License     :  BSD3
--
-- Maintainer  :  cabal-devel@haskell.org
-- Portability :  portable
--
-- This manages everything to do with where files get installed (though does
-- not get involved with actually doing any installation). It provides an
-- 'InstallDirs' type which is a set of directories for where to install
-- things. It also handles the fact that we use templates in these install
-- dirs. For example most install dirs are relative to some @$prefix@ and by
-- changing the prefix all other dirs still end up changed appropriately. So it
-- provides a 'PathTemplate' type and functions for substituting for these
-- templates.

module Distribution.Simple.InstallDirs (
        InstallDirs(..),
        InstallDirTemplates,
        defaultInstallDirs,
        defaultInstallDirs',
        combineInstallDirs,
        absoluteInstallDirs,
        CopyDest(..),
        prefixRelativeInstallDirs,
        substituteInstallDirTemplates,

        PathTemplate,
        PathTemplateVariable(..),
        PathTemplateEnv,
        toPathTemplate,
        fromPathTemplate,
        combinePathTemplate,
        substPathTemplate,
        initialPathTemplateEnv,
        platformTemplateEnv,
        compilerTemplateEnv,
        packageTemplateEnv,
        abiTemplateEnv,
        installDirsTemplateEnv,
  ) where

import Prelude ()
import Distribution.Compat.Prelude

import Distribution.Compat.Environment (lookupEnv)
import Distribution.Pretty
import Distribution.Package
import Distribution.System
import Distribution.Compiler
import Distribution.Simple.InstallDirs.Internal

import System.Directory (getAppUserDataDirectory)
import System.FilePath
  ( (</>), isPathSeparator
  , pathSeparator, dropDrive
  , takeDirectory )

#ifdef mingw32_HOST_OS
import qualified Prelude
import Foreign
import Foreign.C
#endif

-- ---------------------------------------------------------------------------
-- Installation directories


-- | The directories where we will install files for packages.
--
-- We have several different directories for different types of files since
-- many systems have conventions whereby different types of files in a package
-- are installed in different directories. This is particularly the case on
-- Unix style systems.
--
data InstallDirs dir = InstallDirs {
        forall dir. InstallDirs dir -> dir
prefix       :: dir,
        forall dir. InstallDirs dir -> dir
bindir       :: dir,
        forall dir. InstallDirs dir -> dir
libdir       :: dir,
        forall dir. InstallDirs dir -> dir
libsubdir    :: dir,
        forall dir. InstallDirs dir -> dir
dynlibdir    :: dir,
        forall dir. InstallDirs dir -> dir
flibdir      :: dir, -- ^ foreign libraries
        forall dir. InstallDirs dir -> dir
libexecdir   :: dir,
        forall dir. InstallDirs dir -> dir
libexecsubdir:: dir,
        forall dir. InstallDirs dir -> dir
includedir   :: dir,
        forall dir. InstallDirs dir -> dir
datadir      :: dir,
        forall dir. InstallDirs dir -> dir
datasubdir   :: dir,
        forall dir. InstallDirs dir -> dir
docdir       :: dir,
        forall dir. InstallDirs dir -> dir
mandir       :: dir,
        forall dir. InstallDirs dir -> dir
htmldir      :: dir,
        forall dir. InstallDirs dir -> dir
haddockdir   :: dir,
        forall dir. InstallDirs dir -> dir
sysconfdir   :: dir
    } deriving (InstallDirs dir -> InstallDirs dir -> Bool
forall dir. Eq dir => InstallDirs dir -> InstallDirs dir -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InstallDirs dir -> InstallDirs dir -> Bool
$c/= :: forall dir. Eq dir => InstallDirs dir -> InstallDirs dir -> Bool
== :: InstallDirs dir -> InstallDirs dir -> Bool
$c== :: forall dir. Eq dir => InstallDirs dir -> InstallDirs dir -> Bool
Eq, ReadPrec [InstallDirs dir]
ReadPrec (InstallDirs dir)
ReadS [InstallDirs dir]
forall dir. Read dir => ReadPrec [InstallDirs dir]
forall dir. Read dir => ReadPrec (InstallDirs dir)
forall dir. Read dir => Int -> ReadS (InstallDirs dir)
forall dir. Read dir => ReadS [InstallDirs dir]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [InstallDirs dir]
$creadListPrec :: forall dir. Read dir => ReadPrec [InstallDirs dir]
readPrec :: ReadPrec (InstallDirs dir)
$creadPrec :: forall dir. Read dir => ReadPrec (InstallDirs dir)
readList :: ReadS [InstallDirs dir]
$creadList :: forall dir. Read dir => ReadS [InstallDirs dir]
readsPrec :: Int -> ReadS (InstallDirs dir)
$creadsPrec :: forall dir. Read dir => Int -> ReadS (InstallDirs dir)
Read, Int -> InstallDirs dir -> ShowS
forall dir. Show dir => Int -> InstallDirs dir -> ShowS
forall dir. Show dir => [InstallDirs dir] -> ShowS
forall dir. Show dir => InstallDirs dir -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [InstallDirs dir] -> ShowS
$cshowList :: forall dir. Show dir => [InstallDirs dir] -> ShowS
show :: InstallDirs dir -> FilePath
$cshow :: forall dir. Show dir => InstallDirs dir -> FilePath
showsPrec :: Int -> InstallDirs dir -> ShowS
$cshowsPrec :: forall dir. Show dir => Int -> InstallDirs dir -> ShowS
Show, forall a b. a -> InstallDirs b -> InstallDirs a
forall a b. (a -> b) -> InstallDirs a -> InstallDirs b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> InstallDirs b -> InstallDirs a
$c<$ :: forall a b. a -> InstallDirs b -> InstallDirs a
fmap :: forall a b. (a -> b) -> InstallDirs a -> InstallDirs b
$cfmap :: forall a b. (a -> b) -> InstallDirs a -> InstallDirs b
Functor, forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall dir x. Rep (InstallDirs dir) x -> InstallDirs dir
forall dir x. InstallDirs dir -> Rep (InstallDirs dir) x
$cto :: forall dir x. Rep (InstallDirs dir) x -> InstallDirs dir
$cfrom :: forall dir x. InstallDirs dir -> Rep (InstallDirs dir) x
Generic, Typeable)

instance Binary dir => Binary (InstallDirs dir)
instance Structured dir => Structured (InstallDirs dir)

instance (Semigroup dir, Monoid dir) => Monoid (InstallDirs dir) where
  mempty :: InstallDirs dir
mempty = forall a. (Generic a, GMonoid (Rep a)) => a
gmempty
  mappend :: InstallDirs dir -> InstallDirs dir -> InstallDirs dir
mappend = forall a. Semigroup a => a -> a -> a
(<>)

instance Semigroup dir => Semigroup (InstallDirs dir) where
  <> :: InstallDirs dir -> InstallDirs dir -> InstallDirs dir
(<>) = forall a. (Generic a, GSemigroup (Rep a)) => a -> a -> a
gmappend

combineInstallDirs :: (a -> b -> c)
                   -> InstallDirs a
                   -> InstallDirs b
                   -> InstallDirs c
combineInstallDirs :: forall a b c.
(a -> b -> c) -> InstallDirs a -> InstallDirs b -> InstallDirs c
combineInstallDirs a -> b -> c
combine InstallDirs a
a InstallDirs b
b = InstallDirs {
    prefix :: c
prefix       = forall dir. InstallDirs dir -> dir
prefix InstallDirs a
a     a -> b -> c
`combine` forall dir. InstallDirs dir -> dir
prefix InstallDirs b
b,
    bindir :: c
bindir       = forall dir. InstallDirs dir -> dir
bindir InstallDirs a
a     a -> b -> c
`combine` forall dir. InstallDirs dir -> dir
bindir InstallDirs b
b,
    libdir :: c
libdir       = forall dir. InstallDirs dir -> dir
libdir InstallDirs a
a     a -> b -> c
`combine` forall dir. InstallDirs dir -> dir
libdir InstallDirs b
b,
    libsubdir :: c
libsubdir    = forall dir. InstallDirs dir -> dir
libsubdir InstallDirs a
a  a -> b -> c
`combine` forall dir. InstallDirs dir -> dir
libsubdir InstallDirs b
b,
    dynlibdir :: c
dynlibdir    = forall dir. InstallDirs dir -> dir
dynlibdir InstallDirs a
a  a -> b -> c
`combine` forall dir. InstallDirs dir -> dir
dynlibdir InstallDirs b
b,
    flibdir :: c
flibdir      = forall dir. InstallDirs dir -> dir
flibdir InstallDirs a
a    a -> b -> c
`combine` forall dir. InstallDirs dir -> dir
flibdir InstallDirs b
b,
    libexecdir :: c
libexecdir   = forall dir. InstallDirs dir -> dir
libexecdir InstallDirs a
a a -> b -> c
`combine` forall dir. InstallDirs dir -> dir
libexecdir InstallDirs b
b,
    libexecsubdir :: c
libexecsubdir= forall dir. InstallDirs dir -> dir
libexecsubdir InstallDirs a
a a -> b -> c
`combine` forall dir. InstallDirs dir -> dir
libexecsubdir InstallDirs b
b,
    includedir :: c
includedir   = forall dir. InstallDirs dir -> dir
includedir InstallDirs a
a a -> b -> c
`combine` forall dir. InstallDirs dir -> dir
includedir InstallDirs b
b,
    datadir :: c
datadir      = forall dir. InstallDirs dir -> dir
datadir InstallDirs a
a    a -> b -> c
`combine` forall dir. InstallDirs dir -> dir
datadir InstallDirs b
b,
    datasubdir :: c
datasubdir   = forall dir. InstallDirs dir -> dir
datasubdir InstallDirs a
a a -> b -> c
`combine` forall dir. InstallDirs dir -> dir
datasubdir InstallDirs b
b,
    docdir :: c
docdir       = forall dir. InstallDirs dir -> dir
docdir InstallDirs a
a     a -> b -> c
`combine` forall dir. InstallDirs dir -> dir
docdir InstallDirs b
b,
    mandir :: c
mandir       = forall dir. InstallDirs dir -> dir
mandir InstallDirs a
a     a -> b -> c
`combine` forall dir. InstallDirs dir -> dir
mandir InstallDirs b
b,
    htmldir :: c
htmldir      = forall dir. InstallDirs dir -> dir
htmldir InstallDirs a
a    a -> b -> c
`combine` forall dir. InstallDirs dir -> dir
htmldir InstallDirs b
b,
    haddockdir :: c
haddockdir   = forall dir. InstallDirs dir -> dir
haddockdir InstallDirs a
a a -> b -> c
`combine` forall dir. InstallDirs dir -> dir
haddockdir InstallDirs b
b,
    sysconfdir :: c
sysconfdir   = forall dir. InstallDirs dir -> dir
sysconfdir InstallDirs a
a a -> b -> c
`combine` forall dir. InstallDirs dir -> dir
sysconfdir InstallDirs b
b
  }

appendSubdirs :: (a -> a -> a) -> InstallDirs a -> InstallDirs a
appendSubdirs :: forall a. (a -> a -> a) -> InstallDirs a -> InstallDirs a
appendSubdirs a -> a -> a
append InstallDirs a
dirs = InstallDirs a
dirs {
    libdir :: a
libdir     = forall dir. InstallDirs dir -> dir
libdir InstallDirs a
dirs a -> a -> a
`append` forall dir. InstallDirs dir -> dir
libsubdir InstallDirs a
dirs,
    libexecdir :: a
libexecdir = forall dir. InstallDirs dir -> dir
libexecdir InstallDirs a
dirs a -> a -> a
`append` forall dir. InstallDirs dir -> dir
libexecsubdir InstallDirs a
dirs,
    datadir :: a
datadir    = forall dir. InstallDirs dir -> dir
datadir InstallDirs a
dirs a -> a -> a
`append` forall dir. InstallDirs dir -> dir
datasubdir InstallDirs a
dirs,
    libsubdir :: a
libsubdir  = forall a. HasCallStack => FilePath -> a
error FilePath
"internal error InstallDirs.libsubdir",
    libexecsubdir :: a
libexecsubdir = forall a. HasCallStack => FilePath -> a
error FilePath
"internal error InstallDirs.libexecsubdir",
    datasubdir :: a
datasubdir = forall a. HasCallStack => FilePath -> a
error FilePath
"internal error InstallDirs.datasubdir"
  }

-- | The installation directories in terms of 'PathTemplate's that contain
-- variables.
--
-- The defaults for most of the directories are relative to each other, in
-- particular they are all relative to a single prefix. This makes it
-- convenient for the user to override the default installation directory
-- by only having to specify --prefix=... rather than overriding each
-- individually. This is done by allowing $-style variables in the dirs.
-- These are expanded by textual substitution (see 'substPathTemplate').
--
-- A few of these installation directories are split into two components, the
-- dir and subdir. The full installation path is formed by combining the two
-- together with @\/@. The reason for this is compatibility with other Unix
-- build systems which also support @--libdir@ and @--datadir@. We would like
-- users to be able to configure @--libdir=\/usr\/lib64@ for example but
-- because by default we want to support installing multiple versions of
-- packages and building the same package for multiple compilers we append the
-- libsubdir to get: @\/usr\/lib64\/$libname\/$compiler@.
--
-- An additional complication is the need to support relocatable packages on
-- systems which support such things, like Windows.
--
type InstallDirTemplates = InstallDirs PathTemplate

-- ---------------------------------------------------------------------------
-- Default installation directories

defaultInstallDirs :: CompilerFlavor -> Bool -> Bool -> IO InstallDirTemplates
defaultInstallDirs :: CompilerFlavor -> Bool -> Bool -> IO InstallDirTemplates
defaultInstallDirs = Bool -> CompilerFlavor -> Bool -> Bool -> IO InstallDirTemplates
defaultInstallDirs' Bool
False

defaultInstallDirs' :: Bool {- use external internal deps -}
                    -> CompilerFlavor -> Bool -> Bool -> IO InstallDirTemplates
defaultInstallDirs' :: Bool -> CompilerFlavor -> Bool -> Bool -> IO InstallDirTemplates
defaultInstallDirs' Bool
True CompilerFlavor
comp Bool
userInstall Bool
hasLibs = do
  InstallDirTemplates
dflt <- Bool -> CompilerFlavor -> Bool -> Bool -> IO InstallDirTemplates
defaultInstallDirs' Bool
False CompilerFlavor
comp Bool
userInstall Bool
hasLibs
  -- Be a bit more hermetic about per-component installs
  forall (m :: * -> *) a. Monad m => a -> m a
return InstallDirTemplates
dflt { datasubdir :: PathTemplate
datasubdir = FilePath -> PathTemplate
toPathTemplate forall a b. (a -> b) -> a -> b
$ FilePath
"$abi" FilePath -> ShowS
</> FilePath
"$libname",
                docdir :: PathTemplate
docdir     = FilePath -> PathTemplate
toPathTemplate forall a b. (a -> b) -> a -> b
$ FilePath
"$datadir" FilePath -> ShowS
</> FilePath
"doc" FilePath -> ShowS
</> FilePath
"$abi" FilePath -> ShowS
</> FilePath
"$libname"
              }
defaultInstallDirs' Bool
False CompilerFlavor
comp Bool
userInstall Bool
_hasLibs = do
  FilePath
installPrefix <-
      if Bool
userInstall
      then do
        Maybe FilePath
mDir <- FilePath -> IO (Maybe FilePath)
lookupEnv FilePath
"CABAL_DIR"
        case Maybe FilePath
mDir of
          Maybe FilePath
Nothing -> FilePath -> IO FilePath
getAppUserDataDirectory FilePath
"cabal"
          Just FilePath
dir -> forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
dir
      else case OS
buildOS of
           OS
Windows -> do FilePath
windowsProgramFilesDir <- IO FilePath
getWindowsProgramFilesDir
                         forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath
windowsProgramFilesDir FilePath -> ShowS
</> FilePath
"Haskell")
           OS
_       -> forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
"/usr/local"
  FilePath
installLibDir <-
      case OS
buildOS of
      OS
Windows -> forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
"$prefix"
      OS
_       -> forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath
"$prefix" FilePath -> ShowS
</> FilePath
"lib")
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FilePath -> PathTemplate
toPathTemplate forall a b. (a -> b) -> a -> b
$ InstallDirs {
      prefix :: FilePath
prefix       = FilePath
installPrefix,
      bindir :: FilePath
bindir       = FilePath
"$prefix" FilePath -> ShowS
</> FilePath
"bin",
      libdir :: FilePath
libdir       = FilePath
installLibDir,
      libsubdir :: FilePath
libsubdir    = case CompilerFlavor
comp of
           CompilerFlavor
UHC    -> FilePath
"$pkgid"
           CompilerFlavor
_other -> FilePath
"$abi" FilePath -> ShowS
</> FilePath
"$libname",
      dynlibdir :: FilePath
dynlibdir    = FilePath
"$libdir" FilePath -> ShowS
</> case CompilerFlavor
comp of
           CompilerFlavor
UHC    -> FilePath
"$pkgid"
           CompilerFlavor
_other -> FilePath
"$abi",
      libexecsubdir :: FilePath
libexecsubdir= FilePath
"$abi" FilePath -> ShowS
</> FilePath
"$pkgid",
      flibdir :: FilePath
flibdir      = FilePath
"$libdir",
      libexecdir :: FilePath
libexecdir   = case OS
buildOS of
        OS
Windows   -> FilePath
"$prefix" FilePath -> ShowS
</> FilePath
"$libname"
        OS
_other    -> FilePath
"$prefix" FilePath -> ShowS
</> FilePath
"libexec",
      includedir :: FilePath
includedir   = FilePath
"$libdir" FilePath -> ShowS
</> FilePath
"$libsubdir" FilePath -> ShowS
</> FilePath
"include",
      datadir :: FilePath
datadir      = case OS
buildOS of
        OS
Windows   -> FilePath
"$prefix"
        OS
_other    -> FilePath
"$prefix" FilePath -> ShowS
</> FilePath
"share",
      datasubdir :: FilePath
datasubdir   = FilePath
"$abi" FilePath -> ShowS
</> FilePath
"$pkgid",
      docdir :: FilePath
docdir       = FilePath
"$datadir" FilePath -> ShowS
</> FilePath
"doc" FilePath -> ShowS
</> FilePath
"$abi" FilePath -> ShowS
</> FilePath
"$pkgid",
      mandir :: FilePath
mandir       = FilePath
"$datadir" FilePath -> ShowS
</> FilePath
"man",
      htmldir :: FilePath
htmldir      = FilePath
"$docdir"  FilePath -> ShowS
</> FilePath
"html",
      haddockdir :: FilePath
haddockdir   = FilePath
"$htmldir",
      sysconfdir :: FilePath
sysconfdir   = FilePath
"$prefix" FilePath -> ShowS
</> FilePath
"etc"
  }

-- ---------------------------------------------------------------------------
-- Converting directories, absolute or prefix-relative

-- | Substitute the install dir templates into each other.
--
-- To prevent cyclic substitutions, only some variables are allowed in
-- particular dir templates. If out of scope vars are present, they are not
-- substituted for. Checking for any remaining unsubstituted vars can be done
-- as a subsequent operation.
--
-- The reason it is done this way is so that in 'prefixRelativeInstallDirs' we
-- can replace 'prefix' with the 'PrefixVar' and get resulting
-- 'PathTemplate's that still have the 'PrefixVar' in them. Doing this makes it
-- each to check which paths are relative to the $prefix.
--
substituteInstallDirTemplates :: PathTemplateEnv
                              -> InstallDirTemplates -> InstallDirTemplates
substituteInstallDirTemplates :: PathTemplateEnv -> InstallDirTemplates -> InstallDirTemplates
substituteInstallDirTemplates PathTemplateEnv
env InstallDirTemplates
dirs = InstallDirTemplates
dirs'
  where
    dirs' :: InstallDirTemplates
dirs' = InstallDirs {
      -- So this specifies exactly which vars are allowed in each template
      prefix :: PathTemplate
prefix     = (InstallDirTemplates -> PathTemplate)
-> PathTemplateEnv -> PathTemplate
subst forall dir. InstallDirs dir -> dir
prefix     [],
      bindir :: PathTemplate
bindir     = (InstallDirTemplates -> PathTemplate)
-> PathTemplateEnv -> PathTemplate
subst forall dir. InstallDirs dir -> dir
bindir     [(PathTemplateVariable, PathTemplate)
prefixVar],
      libdir :: PathTemplate
libdir     = (InstallDirTemplates -> PathTemplate)
-> PathTemplateEnv -> PathTemplate
subst forall dir. InstallDirs dir -> dir
libdir     [(PathTemplateVariable, PathTemplate)
prefixVar, (PathTemplateVariable, PathTemplate)
bindirVar],
      libsubdir :: PathTemplate
libsubdir  = (InstallDirTemplates -> PathTemplate)
-> PathTemplateEnv -> PathTemplate
subst forall dir. InstallDirs dir -> dir
libsubdir  [],
      dynlibdir :: PathTemplate
dynlibdir  = (InstallDirTemplates -> PathTemplate)
-> PathTemplateEnv -> PathTemplate
subst forall dir. InstallDirs dir -> dir
dynlibdir  [(PathTemplateVariable, PathTemplate)
prefixVar, (PathTemplateVariable, PathTemplate)
bindirVar, (PathTemplateVariable, PathTemplate)
libdirVar],
      flibdir :: PathTemplate
flibdir    = (InstallDirTemplates -> PathTemplate)
-> PathTemplateEnv -> PathTemplate
subst forall dir. InstallDirs dir -> dir
flibdir    [(PathTemplateVariable, PathTemplate)
prefixVar, (PathTemplateVariable, PathTemplate)
bindirVar, (PathTemplateVariable, PathTemplate)
libdirVar],
      libexecdir :: PathTemplate
libexecdir = (InstallDirTemplates -> PathTemplate)
-> PathTemplateEnv -> PathTemplate
subst forall dir. InstallDirs dir -> dir
libexecdir PathTemplateEnv
prefixBinLibVars,
      libexecsubdir :: PathTemplate
libexecsubdir = (InstallDirTemplates -> PathTemplate)
-> PathTemplateEnv -> PathTemplate
subst forall dir. InstallDirs dir -> dir
libexecsubdir [],
      includedir :: PathTemplate
includedir = (InstallDirTemplates -> PathTemplate)
-> PathTemplateEnv -> PathTemplate
subst forall dir. InstallDirs dir -> dir
includedir PathTemplateEnv
prefixBinLibVars,
      datadir :: PathTemplate
datadir    = (InstallDirTemplates -> PathTemplate)
-> PathTemplateEnv -> PathTemplate
subst forall dir. InstallDirs dir -> dir
datadir    PathTemplateEnv
prefixBinLibVars,
      datasubdir :: PathTemplate
datasubdir = (InstallDirTemplates -> PathTemplate)
-> PathTemplateEnv -> PathTemplate
subst forall dir. InstallDirs dir -> dir
datasubdir [],
      docdir :: PathTemplate
docdir     = (InstallDirTemplates -> PathTemplate)
-> PathTemplateEnv -> PathTemplate
subst forall dir. InstallDirs dir -> dir
docdir     PathTemplateEnv
prefixBinLibDataVars,
      mandir :: PathTemplate
mandir     = (InstallDirTemplates -> PathTemplate)
-> PathTemplateEnv -> PathTemplate
subst forall dir. InstallDirs dir -> dir
mandir     (PathTemplateEnv
prefixBinLibDataVars forall a. [a] -> [a] -> [a]
++ [(PathTemplateVariable, PathTemplate)
docdirVar]),
      htmldir :: PathTemplate
htmldir    = (InstallDirTemplates -> PathTemplate)
-> PathTemplateEnv -> PathTemplate
subst forall dir. InstallDirs dir -> dir
htmldir    (PathTemplateEnv
prefixBinLibDataVars forall a. [a] -> [a] -> [a]
++ [(PathTemplateVariable, PathTemplate)
docdirVar]),
      haddockdir :: PathTemplate
haddockdir = (InstallDirTemplates -> PathTemplate)
-> PathTemplateEnv -> PathTemplate
subst forall dir. InstallDirs dir -> dir
haddockdir (PathTemplateEnv
prefixBinLibDataVars forall a. [a] -> [a] -> [a]
++
                                      [(PathTemplateVariable, PathTemplate)
docdirVar, (PathTemplateVariable, PathTemplate)
htmldirVar]),
      sysconfdir :: PathTemplate
sysconfdir = (InstallDirTemplates -> PathTemplate)
-> PathTemplateEnv -> PathTemplate
subst forall dir. InstallDirs dir -> dir
sysconfdir PathTemplateEnv
prefixBinLibVars
    }
    subst :: (InstallDirTemplates -> PathTemplate)
-> PathTemplateEnv -> PathTemplate
subst InstallDirTemplates -> PathTemplate
dir PathTemplateEnv
env' = PathTemplateEnv -> PathTemplate -> PathTemplate
substPathTemplate (PathTemplateEnv
env'forall a. [a] -> [a] -> [a]
++PathTemplateEnv
env) (InstallDirTemplates -> PathTemplate
dir InstallDirTemplates
dirs)

    prefixVar :: (PathTemplateVariable, PathTemplate)
prefixVar        = (PathTemplateVariable
PrefixVar,     forall dir. InstallDirs dir -> dir
prefix     InstallDirTemplates
dirs')
    bindirVar :: (PathTemplateVariable, PathTemplate)
bindirVar        = (PathTemplateVariable
BindirVar,     forall dir. InstallDirs dir -> dir
bindir     InstallDirTemplates
dirs')
    libdirVar :: (PathTemplateVariable, PathTemplate)
libdirVar        = (PathTemplateVariable
LibdirVar,     forall dir. InstallDirs dir -> dir
libdir     InstallDirTemplates
dirs')
    libsubdirVar :: (PathTemplateVariable, PathTemplate)
libsubdirVar     = (PathTemplateVariable
LibsubdirVar,  forall dir. InstallDirs dir -> dir
libsubdir  InstallDirTemplates
dirs')
    datadirVar :: (PathTemplateVariable, PathTemplate)
datadirVar       = (PathTemplateVariable
DatadirVar,    forall dir. InstallDirs dir -> dir
datadir    InstallDirTemplates
dirs')
    datasubdirVar :: (PathTemplateVariable, PathTemplate)
datasubdirVar    = (PathTemplateVariable
DatasubdirVar, forall dir. InstallDirs dir -> dir
datasubdir InstallDirTemplates
dirs')
    docdirVar :: (PathTemplateVariable, PathTemplate)
docdirVar        = (PathTemplateVariable
DocdirVar,     forall dir. InstallDirs dir -> dir
docdir     InstallDirTemplates
dirs')
    htmldirVar :: (PathTemplateVariable, PathTemplate)
htmldirVar       = (PathTemplateVariable
HtmldirVar,    forall dir. InstallDirs dir -> dir
htmldir    InstallDirTemplates
dirs')
    prefixBinLibVars :: PathTemplateEnv
prefixBinLibVars = [(PathTemplateVariable, PathTemplate)
prefixVar, (PathTemplateVariable, PathTemplate)
bindirVar, (PathTemplateVariable, PathTemplate)
libdirVar, (PathTemplateVariable, PathTemplate)
libsubdirVar]
    prefixBinLibDataVars :: PathTemplateEnv
prefixBinLibDataVars = PathTemplateEnv
prefixBinLibVars forall a. [a] -> [a] -> [a]
++ [(PathTemplateVariable, PathTemplate)
datadirVar, (PathTemplateVariable, PathTemplate)
datasubdirVar]

-- | Convert from abstract install directories to actual absolute ones by
-- substituting for all the variables in the abstract paths, to get real
-- absolute path.
absoluteInstallDirs :: PackageIdentifier
                    -> UnitId
                    -> CompilerInfo
                    -> CopyDest
                    -> Platform
                    -> InstallDirs PathTemplate
                    -> InstallDirs FilePath
absoluteInstallDirs :: PackageIdentifier
-> UnitId
-> CompilerInfo
-> CopyDest
-> Platform
-> InstallDirTemplates
-> InstallDirs FilePath
absoluteInstallDirs PackageIdentifier
pkgId UnitId
libname CompilerInfo
compilerId CopyDest
copydest Platform
platform InstallDirTemplates
dirs =
    (case CopyDest
copydest of
       CopyTo FilePath
destdir -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((FilePath
destdir FilePath -> ShowS
</>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
dropDrive)
       CopyToDb FilePath
dbdir -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall {a}. Eq a => [a] -> [a] -> [a] -> [a]
substPrefix FilePath
"${pkgroot}" (ShowS
takeDirectory FilePath
dbdir))
       CopyDest
_              -> forall a. a -> a
id)
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> a -> a) -> InstallDirs a -> InstallDirs a
appendSubdirs FilePath -> ShowS
(</>)
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PathTemplate -> FilePath
fromPathTemplate
  forall a b. (a -> b) -> a -> b
$ PathTemplateEnv -> InstallDirTemplates -> InstallDirTemplates
substituteInstallDirTemplates PathTemplateEnv
env InstallDirTemplates
dirs
  where
    env :: PathTemplateEnv
env = PackageIdentifier
-> UnitId -> CompilerInfo -> Platform -> PathTemplateEnv
initialPathTemplateEnv PackageIdentifier
pkgId UnitId
libname CompilerInfo
compilerId Platform
platform
    substPrefix :: [a] -> [a] -> [a] -> [a]
substPrefix [a]
pre [a]
root [a]
path
      | [a]
pre forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` [a]
path = [a]
root forall a. [a] -> [a] -> [a]
++ forall a. Int -> [a] -> [a]
drop (forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
pre) [a]
path
      | Bool
otherwise             = [a]
path


-- |The location prefix for the /copy/ command.
data CopyDest
  = NoCopyDest
  | CopyTo FilePath
  | CopyToDb FilePath
  -- ^ when using the ${pkgroot} as prefix. The CopyToDb will
  --   adjust the paths to be relative to the provided package
  --   database when copying / installing.
  deriving (CopyDest -> CopyDest -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CopyDest -> CopyDest -> Bool
$c/= :: CopyDest -> CopyDest -> Bool
== :: CopyDest -> CopyDest -> Bool
$c== :: CopyDest -> CopyDest -> Bool
Eq, Int -> CopyDest -> ShowS
[CopyDest] -> ShowS
CopyDest -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [CopyDest] -> ShowS
$cshowList :: [CopyDest] -> ShowS
show :: CopyDest -> FilePath
$cshow :: CopyDest -> FilePath
showsPrec :: Int -> CopyDest -> ShowS
$cshowsPrec :: Int -> CopyDest -> ShowS
Show, forall x. Rep CopyDest x -> CopyDest
forall x. CopyDest -> Rep CopyDest x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CopyDest x -> CopyDest
$cfrom :: forall x. CopyDest -> Rep CopyDest x
Generic)

instance Binary CopyDest

-- | Check which of the paths are relative to the installation $prefix.
--
-- If any of the paths are not relative, ie they are absolute paths, then it
-- prevents us from making a relocatable package (also known as a \"prefix
-- independent\" package).
--
prefixRelativeInstallDirs :: PackageIdentifier
                          -> UnitId
                          -> CompilerInfo
                          -> Platform
                          -> InstallDirTemplates
                          -> InstallDirs (Maybe FilePath)
prefixRelativeInstallDirs :: PackageIdentifier
-> UnitId
-> CompilerInfo
-> Platform
-> InstallDirTemplates
-> InstallDirs (Maybe FilePath)
prefixRelativeInstallDirs PackageIdentifier
pkgId UnitId
libname CompilerInfo
compilerId Platform
platform InstallDirTemplates
dirs =
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PathTemplate -> Maybe FilePath
relative
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> a -> a) -> InstallDirs a -> InstallDirs a
appendSubdirs PathTemplate -> PathTemplate -> PathTemplate
combinePathTemplate
  forall a b. (a -> b) -> a -> b
$ -- substitute the path template into each other, except that we map
    -- \$prefix back to $prefix. We're trying to end up with templates that
    -- mention no vars except $prefix.
    PathTemplateEnv -> InstallDirTemplates -> InstallDirTemplates
substituteInstallDirTemplates PathTemplateEnv
env InstallDirTemplates
dirs {
      prefix :: PathTemplate
prefix = [PathComponent] -> PathTemplate
PathTemplate [PathTemplateVariable -> PathComponent
Variable PathTemplateVariable
PrefixVar]
    }
  where
    env :: PathTemplateEnv
env = PackageIdentifier
-> UnitId -> CompilerInfo -> Platform -> PathTemplateEnv
initialPathTemplateEnv PackageIdentifier
pkgId UnitId
libname CompilerInfo
compilerId Platform
platform

    -- If it starts with $prefix then it's relative and produce the relative
    -- path by stripping off $prefix/ or $prefix
    relative :: PathTemplate -> Maybe FilePath
relative PathTemplate
dir = case PathTemplate
dir of
      PathTemplate [PathComponent]
cs -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (PathTemplate -> FilePath
fromPathTemplate forall b c a. (b -> c) -> (a -> b) -> a -> c
. [PathComponent] -> PathTemplate
PathTemplate) ([PathComponent] -> Maybe [PathComponent]
relative' [PathComponent]
cs)
    relative' :: [PathComponent] -> Maybe [PathComponent]
relative' (Variable PathTemplateVariable
PrefixVar : Ordinary (Char
s:FilePath
rest) : [PathComponent]
rest')
                      | Char -> Bool
isPathSeparator Char
s = forall a. a -> Maybe a
Just (FilePath -> PathComponent
Ordinary FilePath
rest forall a. a -> [a] -> [a]
: [PathComponent]
rest')
    relative' (Variable PathTemplateVariable
PrefixVar : [PathComponent]
rest) = forall a. a -> Maybe a
Just [PathComponent]
rest
    relative' [PathComponent]
_                           = forall a. Maybe a
Nothing

-- ---------------------------------------------------------------------------
-- Path templates

-- | An abstract path, possibly containing variables that need to be
-- substituted for to get a real 'FilePath'.
--
newtype PathTemplate = PathTemplate [PathComponent]
  deriving (PathTemplate -> PathTemplate -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PathTemplate -> PathTemplate -> Bool
$c/= :: PathTemplate -> PathTemplate -> Bool
== :: PathTemplate -> PathTemplate -> Bool
$c== :: PathTemplate -> PathTemplate -> Bool
Eq, Eq PathTemplate
PathTemplate -> PathTemplate -> Bool
PathTemplate -> PathTemplate -> Ordering
PathTemplate -> PathTemplate -> PathTemplate
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: PathTemplate -> PathTemplate -> PathTemplate
$cmin :: PathTemplate -> PathTemplate -> PathTemplate
max :: PathTemplate -> PathTemplate -> PathTemplate
$cmax :: PathTemplate -> PathTemplate -> PathTemplate
>= :: PathTemplate -> PathTemplate -> Bool
$c>= :: PathTemplate -> PathTemplate -> Bool
> :: PathTemplate -> PathTemplate -> Bool
$c> :: PathTemplate -> PathTemplate -> Bool
<= :: PathTemplate -> PathTemplate -> Bool
$c<= :: PathTemplate -> PathTemplate -> Bool
< :: PathTemplate -> PathTemplate -> Bool
$c< :: PathTemplate -> PathTemplate -> Bool
compare :: PathTemplate -> PathTemplate -> Ordering
$ccompare :: PathTemplate -> PathTemplate -> Ordering
Ord, forall x. Rep PathTemplate x -> PathTemplate
forall x. PathTemplate -> Rep PathTemplate x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PathTemplate x -> PathTemplate
$cfrom :: forall x. PathTemplate -> Rep PathTemplate x
Generic, Typeable)

instance Binary PathTemplate
instance Structured PathTemplate

type PathTemplateEnv = [(PathTemplateVariable, PathTemplate)]

-- | Convert a 'FilePath' to a 'PathTemplate' including any template vars.
--
toPathTemplate :: FilePath -> PathTemplate
toPathTemplate :: FilePath -> PathTemplate
toPathTemplate FilePath
fp = [PathComponent] -> PathTemplate
PathTemplate
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => FilePath -> a
error forall a b. (a -> b) -> a -> b
$ FilePath
"panic! toPathTemplate " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> FilePath
show FilePath
fp)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Read a => FilePath -> Maybe a
readMaybe -- TODO: eradicateNoParse
    forall a b. (a -> b) -> a -> b
$ FilePath
fp

-- | Convert back to a path, any remaining vars are included
--
fromPathTemplate :: PathTemplate -> FilePath
fromPathTemplate :: PathTemplate -> FilePath
fromPathTemplate (PathTemplate [PathComponent]
template) = forall a. Show a => a -> FilePath
show [PathComponent]
template

combinePathTemplate :: PathTemplate -> PathTemplate -> PathTemplate
combinePathTemplate :: PathTemplate -> PathTemplate -> PathTemplate
combinePathTemplate (PathTemplate [PathComponent]
t1) (PathTemplate [PathComponent]
t2) =
  [PathComponent] -> PathTemplate
PathTemplate ([PathComponent]
t1 forall a. [a] -> [a] -> [a]
++ [FilePath -> PathComponent
Ordinary [Char
pathSeparator]] forall a. [a] -> [a] -> [a]
++ [PathComponent]
t2)

substPathTemplate :: PathTemplateEnv -> PathTemplate -> PathTemplate
substPathTemplate :: PathTemplateEnv -> PathTemplate -> PathTemplate
substPathTemplate PathTemplateEnv
environment (PathTemplate [PathComponent]
template) =
    [PathComponent] -> PathTemplate
PathTemplate (forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap PathComponent -> [PathComponent]
subst [PathComponent]
template)

    where subst :: PathComponent -> [PathComponent]
subst component :: PathComponent
component@(Ordinary FilePath
_) = [PathComponent
component]
          subst component :: PathComponent
component@(Variable PathTemplateVariable
variable) =
              case forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup PathTemplateVariable
variable PathTemplateEnv
environment of
                  Just (PathTemplate [PathComponent]
components) -> [PathComponent]
components
                  Maybe PathTemplate
Nothing                        -> [PathComponent
component]

-- | The initial environment has all the static stuff but no paths
initialPathTemplateEnv :: PackageIdentifier
                       -> UnitId
                       -> CompilerInfo
                       -> Platform
                       -> PathTemplateEnv
initialPathTemplateEnv :: PackageIdentifier
-> UnitId -> CompilerInfo -> Platform -> PathTemplateEnv
initialPathTemplateEnv PackageIdentifier
pkgId UnitId
libname CompilerInfo
compiler Platform
platform =
     PackageIdentifier -> UnitId -> PathTemplateEnv
packageTemplateEnv  PackageIdentifier
pkgId UnitId
libname
  forall a. [a] -> [a] -> [a]
++ CompilerInfo -> PathTemplateEnv
compilerTemplateEnv CompilerInfo
compiler
  forall a. [a] -> [a] -> [a]
++ Platform -> PathTemplateEnv
platformTemplateEnv Platform
platform
  forall a. [a] -> [a] -> [a]
++ CompilerInfo -> Platform -> PathTemplateEnv
abiTemplateEnv CompilerInfo
compiler Platform
platform

packageTemplateEnv :: PackageIdentifier -> UnitId -> PathTemplateEnv
packageTemplateEnv :: PackageIdentifier -> UnitId -> PathTemplateEnv
packageTemplateEnv PackageIdentifier
pkgId UnitId
uid =
  [(PathTemplateVariable
PkgNameVar,  [PathComponent] -> PathTemplate
PathTemplate [FilePath -> PathComponent
Ordinary forall a b. (a -> b) -> a -> b
$ forall a. Pretty a => a -> FilePath
prettyShow (forall pkg. Package pkg => pkg -> PackageName
packageName PackageIdentifier
pkgId)])
  ,(PathTemplateVariable
PkgVerVar,   [PathComponent] -> PathTemplate
PathTemplate [FilePath -> PathComponent
Ordinary forall a b. (a -> b) -> a -> b
$ forall a. Pretty a => a -> FilePath
prettyShow (forall pkg. Package pkg => pkg -> Version
packageVersion PackageIdentifier
pkgId)])
  -- Invariant: uid is actually a HashedUnitId.  Hard to enforce because
  -- it's an API change.
  ,(PathTemplateVariable
LibNameVar,  [PathComponent] -> PathTemplate
PathTemplate [FilePath -> PathComponent
Ordinary forall a b. (a -> b) -> a -> b
$ forall a. Pretty a => a -> FilePath
prettyShow UnitId
uid])
  ,(PathTemplateVariable
PkgIdVar,    [PathComponent] -> PathTemplate
PathTemplate [FilePath -> PathComponent
Ordinary forall a b. (a -> b) -> a -> b
$ forall a. Pretty a => a -> FilePath
prettyShow PackageIdentifier
pkgId])
  ]

compilerTemplateEnv :: CompilerInfo -> PathTemplateEnv
compilerTemplateEnv :: CompilerInfo -> PathTemplateEnv
compilerTemplateEnv CompilerInfo
compiler =
  [(PathTemplateVariable
CompilerVar, [PathComponent] -> PathTemplate
PathTemplate [FilePath -> PathComponent
Ordinary forall a b. (a -> b) -> a -> b
$ forall a. Pretty a => a -> FilePath
prettyShow (CompilerInfo -> CompilerId
compilerInfoId CompilerInfo
compiler)])
  ]

platformTemplateEnv :: Platform -> PathTemplateEnv
platformTemplateEnv :: Platform -> PathTemplateEnv
platformTemplateEnv (Platform Arch
arch OS
os) =
  [(PathTemplateVariable
OSVar,       [PathComponent] -> PathTemplate
PathTemplate [FilePath -> PathComponent
Ordinary forall a b. (a -> b) -> a -> b
$ forall a. Pretty a => a -> FilePath
prettyShow OS
os])
  ,(PathTemplateVariable
ArchVar,     [PathComponent] -> PathTemplate
PathTemplate [FilePath -> PathComponent
Ordinary forall a b. (a -> b) -> a -> b
$ forall a. Pretty a => a -> FilePath
prettyShow Arch
arch])
  ]

abiTemplateEnv :: CompilerInfo -> Platform -> PathTemplateEnv
abiTemplateEnv :: CompilerInfo -> Platform -> PathTemplateEnv
abiTemplateEnv CompilerInfo
compiler (Platform Arch
arch OS
os) =
  [(PathTemplateVariable
AbiVar,      [PathComponent] -> PathTemplate
PathTemplate [FilePath -> PathComponent
Ordinary forall a b. (a -> b) -> a -> b
$ forall a. Pretty a => a -> FilePath
prettyShow Arch
arch forall a. [a] -> [a] -> [a]
++ Char
'-'forall a. a -> [a] -> [a]
:forall a. Pretty a => a -> FilePath
prettyShow OS
os forall a. [a] -> [a] -> [a]
++
                                          Char
'-'forall a. a -> [a] -> [a]
:forall a. Pretty a => a -> FilePath
prettyShow (CompilerInfo -> CompilerId
compilerInfoId CompilerInfo
compiler) forall a. [a] -> [a] -> [a]
++
                                          case CompilerInfo -> AbiTag
compilerInfoAbiTag CompilerInfo
compiler of
                                            AbiTag
NoAbiTag   -> FilePath
""
                                            AbiTag FilePath
tag -> Char
'-'forall a. a -> [a] -> [a]
:FilePath
tag])
  ,(PathTemplateVariable
AbiTagVar,   [PathComponent] -> PathTemplate
PathTemplate [FilePath -> PathComponent
Ordinary forall a b. (a -> b) -> a -> b
$ AbiTag -> FilePath
abiTagString (CompilerInfo -> AbiTag
compilerInfoAbiTag CompilerInfo
compiler)])
  ]

installDirsTemplateEnv :: InstallDirs PathTemplate -> PathTemplateEnv
installDirsTemplateEnv :: InstallDirTemplates -> PathTemplateEnv
installDirsTemplateEnv InstallDirTemplates
dirs =
  [(PathTemplateVariable
PrefixVar,     forall dir. InstallDirs dir -> dir
prefix     InstallDirTemplates
dirs)
  ,(PathTemplateVariable
BindirVar,     forall dir. InstallDirs dir -> dir
bindir     InstallDirTemplates
dirs)
  ,(PathTemplateVariable
LibdirVar,     forall dir. InstallDirs dir -> dir
libdir     InstallDirTemplates
dirs)
  ,(PathTemplateVariable
LibsubdirVar,  forall dir. InstallDirs dir -> dir
libsubdir  InstallDirTemplates
dirs)
  ,(PathTemplateVariable
DynlibdirVar,  forall dir. InstallDirs dir -> dir
dynlibdir  InstallDirTemplates
dirs)
  ,(PathTemplateVariable
DatadirVar,    forall dir. InstallDirs dir -> dir
datadir    InstallDirTemplates
dirs)
  ,(PathTemplateVariable
DatasubdirVar, forall dir. InstallDirs dir -> dir
datasubdir InstallDirTemplates
dirs)
  ,(PathTemplateVariable
DocdirVar,     forall dir. InstallDirs dir -> dir
docdir     InstallDirTemplates
dirs)
  ,(PathTemplateVariable
HtmldirVar,    forall dir. InstallDirs dir -> dir
htmldir    InstallDirTemplates
dirs)
  ]


-- ---------------------------------------------------------------------------
-- Parsing and showing path templates:

-- The textual format is that of an ordinary Haskell String, eg
-- "$prefix/bin"
-- and this gets parsed to the internal representation as a sequence of path
-- spans which are either strings or variables, eg:
-- PathTemplate [Variable PrefixVar, Ordinary "/bin" ]

instance Show PathTemplate where
  show :: PathTemplate -> FilePath
show (PathTemplate [PathComponent]
template) = forall a. Show a => a -> FilePath
show (forall a. Show a => a -> FilePath
show [PathComponent]
template)

instance Read PathTemplate where
  readsPrec :: Int -> ReadS PathTemplate
readsPrec Int
p FilePath
s = [ ([PathComponent] -> PathTemplate
PathTemplate [PathComponent]
template, FilePath
s')
                  | (FilePath
path, FilePath
s')     <- forall a. Read a => Int -> ReadS a
readsPrec Int
p FilePath
s
                  , ([PathComponent]
template, FilePath
"") <- forall a. Read a => ReadS a
reads FilePath
path ]

-- ---------------------------------------------------------------------------
-- Internal utilities

getWindowsProgramFilesDir :: IO FilePath
getWindowsProgramFilesDir :: IO FilePath
getWindowsProgramFilesDir = do
#ifdef mingw32_HOST_OS
  m <- shGetFolderPath csidl_PROGRAM_FILES
#else
  let m :: Maybe a
m = forall a. Maybe a
Nothing
#endif
  forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a -> a
fromMaybe FilePath
"C:\\Program Files" forall a. Maybe a
m)

#ifdef mingw32_HOST_OS
shGetFolderPath :: CInt -> IO (Maybe FilePath)
shGetFolderPath n =
  allocaArray long_path_size $ \pPath -> do
     r <- c_SHGetFolderPath nullPtr n nullPtr 0 pPath
     if (r /= 0)
        then return Nothing
        else do s <- peekCWString pPath; return (Just s)
  where
    long_path_size      = 1024 -- MAX_PATH is 260, this should be plenty

csidl_PROGRAM_FILES :: CInt
csidl_PROGRAM_FILES = 0x0026
-- csidl_PROGRAM_FILES_COMMON :: CInt
-- csidl_PROGRAM_FILES_COMMON = 0x002b

#ifdef x86_64_HOST_ARCH
#define CALLCONV ccall
#else
#define CALLCONV stdcall
#endif

foreign import CALLCONV unsafe "shlobj.h SHGetFolderPathW"
            c_SHGetFolderPath :: Ptr ()
                              -> CInt
                              -> Ptr ()
                              -> CInt
                              -> CWString
                              -> Prelude.IO CInt
#endif