{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RankNTypes #-}

-----------------------------------------------------------------------------
-- |
-- Module      :  Distribution.Simple.UHC
-- Copyright   :  Andres Loeh 2009
-- License     :  BSD3
--
-- Maintainer  :  cabal-devel@haskell.org
-- Portability :  portable
--
-- This module contains most of the UHC-specific code for configuring, building
-- and installing packages.
--
-- Thanks to the authors of the other implementation-specific files, in
-- particular to Isaac Jones, Duncan Coutts and Henning Thielemann, for
-- inspiration on how to design this module.

module Distribution.Simple.UHC (
    configure, getInstalledPackages,
    buildLib, buildExe, installLib, registerPackage, inplacePackageDbPath
  ) where

import Prelude ()
import Distribution.Compat.Prelude

import Distribution.InstalledPackageInfo
import Distribution.Package hiding (installedUnitId)
import Distribution.PackageDescription
import Distribution.Simple.BuildPaths
import Distribution.Simple.Compiler
import Distribution.Simple.LocalBuildInfo
import Distribution.Simple.PackageIndex
import Distribution.Simple.Program
import Distribution.Simple.Utils
import Distribution.Pretty
import Distribution.Parsec
import Distribution.Types.MungedPackageId
import Distribution.Verbosity
import Distribution.Version
import Distribution.System
import Language.Haskell.Extension
import Distribution.Utils.Path

import qualified Data.Map as Map ( empty )
import System.Directory
import System.FilePath

-- -----------------------------------------------------------------------------
-- Configuring

configure :: Verbosity -> Maybe FilePath -> Maybe FilePath
          -> ProgramDb -> IO (Compiler, Maybe Platform, ProgramDb)
configure :: Verbosity
-> Maybe FilePath
-> Maybe FilePath
-> ProgramDb
-> IO (Compiler, Maybe Platform, ProgramDb)
configure Verbosity
verbosity Maybe FilePath
hcPath Maybe FilePath
_hcPkgPath ProgramDb
progdb = do

  (ConfiguredProgram
_uhcProg, Version
uhcVersion, ProgramDb
progdb') <-
    Verbosity
-> Program
-> VersionRange
-> ProgramDb
-> IO (ConfiguredProgram, Version, ProgramDb)
requireProgramVersion Verbosity
verbosity Program
uhcProgram
    (Version -> VersionRange
orLaterVersion ([Int] -> Version
mkVersion [Int
1,Int
0,Int
2]))
    (FilePath -> Maybe FilePath -> ProgramDb -> ProgramDb
userMaybeSpecifyPath FilePath
"uhc" Maybe FilePath
hcPath ProgramDb
progdb)

  let comp :: Compiler
comp = Compiler {
               compilerId :: CompilerId
compilerId         =  CompilerFlavor -> Version -> CompilerId
CompilerId CompilerFlavor
UHC Version
uhcVersion,
               compilerAbiTag :: AbiTag
compilerAbiTag     =  AbiTag
NoAbiTag,
               compilerCompat :: [CompilerId]
compilerCompat     =  [],
               compilerLanguages :: [(Language, FilePath)]
compilerLanguages  =  [(Language, FilePath)]
uhcLanguages,
               compilerExtensions :: [(Extension, Maybe FilePath)]
compilerExtensions =  [(Extension, Maybe FilePath)]
uhcLanguageExtensions,
               compilerProperties :: Map FilePath FilePath
compilerProperties =  forall k a. Map k a
Map.empty
             }
      compPlatform :: Maybe a
compPlatform = forall a. Maybe a
Nothing
  forall (m :: * -> *) a. Monad m => a -> m a
return (Compiler
comp, forall a. Maybe a
compPlatform, ProgramDb
progdb')

uhcLanguages :: [(Language, CompilerFlag)]
uhcLanguages :: [(Language, FilePath)]
uhcLanguages = [(Language
Haskell98, FilePath
"")]

-- | The flags for the supported extensions.
uhcLanguageExtensions :: [(Extension, Maybe CompilerFlag)]
uhcLanguageExtensions :: [(Extension, Maybe FilePath)]
uhcLanguageExtensions =
    let doFlag :: (KnownExtension, (b, b)) -> [(Extension, b)]
doFlag (KnownExtension
f, (b
enable, b
disable)) = [(KnownExtension -> Extension
EnableExtension  KnownExtension
f, b
enable),
                                         (KnownExtension -> Extension
DisableExtension KnownExtension
f, b
disable)]
        alwaysOn :: (Maybe a, Maybe a)
alwaysOn = (forall a. Maybe a
Nothing, forall a. Maybe a
Nothing{- wrong -})
    in forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall {b}. (KnownExtension, (b, b)) -> [(Extension, b)]
doFlag
    [(KnownExtension
CPP,                          (forall a. a -> Maybe a
Just FilePath
"--cpp", forall a. Maybe a
Nothing{- wrong -})),
     (KnownExtension
PolymorphicComponents,        forall {a} {a}. (Maybe a, Maybe a)
alwaysOn),
     (KnownExtension
ExistentialQuantification,    forall {a} {a}. (Maybe a, Maybe a)
alwaysOn),
     (KnownExtension
ForeignFunctionInterface,     forall {a} {a}. (Maybe a, Maybe a)
alwaysOn),
     (KnownExtension
UndecidableInstances,         forall {a} {a}. (Maybe a, Maybe a)
alwaysOn),
     (KnownExtension
MultiParamTypeClasses,        forall {a} {a}. (Maybe a, Maybe a)
alwaysOn),
     (KnownExtension
Rank2Types,                   forall {a} {a}. (Maybe a, Maybe a)
alwaysOn),
     (KnownExtension
PatternSignatures,            forall {a} {a}. (Maybe a, Maybe a)
alwaysOn),
     (KnownExtension
EmptyDataDecls,               forall {a} {a}. (Maybe a, Maybe a)
alwaysOn),
     (KnownExtension
ImplicitPrelude,              (forall a. Maybe a
Nothing, forall a. a -> Maybe a
Just FilePath
"--no-prelude"{- wrong -})),
     (KnownExtension
TypeOperators,                forall {a} {a}. (Maybe a, Maybe a)
alwaysOn),
     (KnownExtension
OverlappingInstances,         forall {a} {a}. (Maybe a, Maybe a)
alwaysOn),
     (KnownExtension
FlexibleInstances,            forall {a} {a}. (Maybe a, Maybe a)
alwaysOn)]

getInstalledPackages :: Verbosity -> Compiler -> PackageDBStack -> ProgramDb
                     -> IO InstalledPackageIndex
getInstalledPackages :: Verbosity
-> Compiler
-> PackageDBStack
-> ProgramDb
-> IO InstalledPackageIndex
getInstalledPackages Verbosity
verbosity Compiler
comp PackageDBStack
packagedbs ProgramDb
progdb = do
  let compilerid :: CompilerId
compilerid = Compiler -> CompilerId
compilerId Compiler
comp
  FilePath
systemPkgDir <- Verbosity -> ProgramDb -> IO FilePath
getGlobalPackageDir Verbosity
verbosity ProgramDb
progdb
  FilePath
userPkgDir   <- IO FilePath
getUserPackageDir
  let pkgDirs :: [FilePath]
pkgDirs    = forall a. Eq a => [a] -> [a]
nub (forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (FilePath -> FilePath -> PackageDB -> [FilePath]
packageDbPaths FilePath
userPkgDir FilePath
systemPkgDir) PackageDBStack
packagedbs)
  -- putStrLn $ "pkgdirs: " ++ show pkgDirs
  [FilePath]
pkgs <- forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (forall a b. (a -> b) -> [a] -> [b]
map FilePath -> FilePath
addBuiltinVersions forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat) forall a b. (a -> b) -> a -> b
$
          forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (\ FilePath
d -> FilePath -> IO [FilePath]
getDirectoryContents FilePath
d forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM (FilePath -> FilePath -> FilePath -> IO Bool
isPkgDir (forall a. Pretty a => a -> FilePath
prettyShow CompilerId
compilerid) FilePath
d))
          [FilePath]
pkgDirs
  -- putStrLn $ "pkgs: " ++ show pkgs
  let iPkgs :: [InstalledPackageInfo]
iPkgs =
        forall a b. (a -> b) -> [a] -> [b]
map PackageIdentifier -> InstalledPackageInfo
mkInstalledPackageInfo forall a b. (a -> b) -> a -> b
$
        forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap FilePath -> [PackageIdentifier]
parsePackage forall a b. (a -> b) -> a -> b
$
        [FilePath]
pkgs
  -- putStrLn $ "installed pkgs: " ++ show iPkgs
  forall (m :: * -> *) a. Monad m => a -> m a
return ([InstalledPackageInfo] -> InstalledPackageIndex
fromList [InstalledPackageInfo]
iPkgs)

getGlobalPackageDir :: Verbosity -> ProgramDb -> IO FilePath
getGlobalPackageDir :: Verbosity -> ProgramDb -> IO FilePath
getGlobalPackageDir Verbosity
verbosity ProgramDb
progdb = do
    FilePath
output <- Verbosity -> Program -> ProgramDb -> [FilePath] -> IO FilePath
getDbProgramOutput Verbosity
verbosity
                Program
uhcProgram ProgramDb
progdb [FilePath
"--meta-pkgdir-system"]
    -- we need to trim because pkgdir contains an extra newline at the end
    let pkgdir :: FilePath
pkgdir = FilePath -> FilePath
trimEnd FilePath
output
    forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
pkgdir
  where
    trimEnd :: FilePath -> FilePath
trimEnd = forall a. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
reverse

getUserPackageDir :: IO FilePath
getUserPackageDir :: IO FilePath
getUserPackageDir = do
    FilePath
homeDir <- IO FilePath
getHomeDirectory
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ FilePath
homeDir FilePath -> FilePath -> FilePath
</> FilePath
".cabal" FilePath -> FilePath -> FilePath
</> FilePath
"lib"  -- TODO: determine in some other way

packageDbPaths :: FilePath -> FilePath -> PackageDB -> [FilePath]
packageDbPaths :: FilePath -> FilePath -> PackageDB -> [FilePath]
packageDbPaths FilePath
user FilePath
system PackageDB
db =
  case PackageDB
db of
    PackageDB
GlobalPackageDB         ->  [ FilePath
system ]
    PackageDB
UserPackageDB           ->  [ FilePath
user ]
    SpecificPackageDB FilePath
path  ->  [ FilePath
path ]

-- | Hack to add version numbers to UHC-built-in packages. This should sooner or
-- later be fixed on the UHC side.
addBuiltinVersions :: String -> String
{-
addBuiltinVersions "uhcbase"  = "uhcbase-1.0"
addBuiltinVersions "base"  = "base-3.0"
addBuiltinVersions "array" = "array-0.2"
-}
addBuiltinVersions :: FilePath -> FilePath
addBuiltinVersions FilePath
xs      = FilePath
xs

-- | Name of the installed package config file.
installedPkgConfig :: String
installedPkgConfig :: FilePath
installedPkgConfig = FilePath
"installed-pkg-config"

-- | Check if a certain dir contains a valid package. Currently, we are
-- looking only for the presence of an installed package configuration.
-- TODO: Actually make use of the information provided in the file.
isPkgDir :: String -> String -> String -> IO Bool
isPkgDir :: FilePath -> FilePath -> FilePath -> IO Bool
isPkgDir FilePath
_ FilePath
_   (Char
'.' : FilePath
_)  = forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False  -- ignore files starting with a .
isPkgDir FilePath
c FilePath
dir FilePath
xs         = do
                              let candidate :: FilePath
candidate = FilePath
dir FilePath -> FilePath -> FilePath
</> FilePath -> FilePath -> FilePath
uhcPackageDir FilePath
xs FilePath
c
                              -- putStrLn $ "trying: " ++ candidate
                              FilePath -> IO Bool
doesFileExist (FilePath
candidate FilePath -> FilePath -> FilePath
</> FilePath
installedPkgConfig)

parsePackage :: String -> [PackageId]
parsePackage :: FilePath -> [PackageIdentifier]
parsePackage = forall (t :: * -> *) a. Foldable t => t a -> [a]
toList  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Parsec a => FilePath -> Maybe a
simpleParsec

-- | Create a trivial package info from a directory name.
mkInstalledPackageInfo :: PackageId -> InstalledPackageInfo
mkInstalledPackageInfo :: PackageIdentifier -> InstalledPackageInfo
mkInstalledPackageInfo PackageIdentifier
p = InstalledPackageInfo
emptyInstalledPackageInfo
  { installedUnitId :: UnitId
installedUnitId = PackageIdentifier -> UnitId
mkLegacyUnitId PackageIdentifier
p,
    sourcePackageId :: PackageIdentifier
sourcePackageId = PackageIdentifier
p }


-- -----------------------------------------------------------------------------
-- Building

buildLib :: Verbosity -> PackageDescription -> LocalBuildInfo
                      -> Library            -> ComponentLocalBuildInfo -> IO ()
buildLib :: Verbosity
-> PackageDescription
-> LocalBuildInfo
-> Library
-> ComponentLocalBuildInfo
-> IO ()
buildLib Verbosity
verbosity PackageDescription
pkg_descr LocalBuildInfo
lbi Library
lib ComponentLocalBuildInfo
clbi = do

  FilePath
systemPkgDir <- Verbosity -> ProgramDb -> IO FilePath
getGlobalPackageDir Verbosity
verbosity (LocalBuildInfo -> ProgramDb
withPrograms LocalBuildInfo
lbi)
  FilePath
userPkgDir   <- IO FilePath
getUserPackageDir
  let runUhcProg :: [FilePath] -> IO ()
runUhcProg = Verbosity -> Program -> ProgramDb -> [FilePath] -> IO ()
runDbProgram Verbosity
verbosity Program
uhcProgram (LocalBuildInfo -> ProgramDb
withPrograms LocalBuildInfo
lbi)
  let uhcArgs :: [FilePath]
uhcArgs =    -- set package name
                   [FilePath
"--pkg-build=" forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> FilePath
prettyShow (forall pkg. Package pkg => pkg -> PackageIdentifier
packageId PackageDescription
pkg_descr)]
                   -- common flags lib/exe
                forall a. [a] -> [a] -> [a]
++ FilePath
-> FilePath
-> LocalBuildInfo
-> BuildInfo
-> ComponentLocalBuildInfo
-> FilePath
-> Verbosity
-> [FilePath]
constructUHCCmdLine FilePath
userPkgDir FilePath
systemPkgDir
                                       LocalBuildInfo
lbi (Library -> BuildInfo
libBuildInfo Library
lib) ComponentLocalBuildInfo
clbi
                                       (LocalBuildInfo -> FilePath
buildDir LocalBuildInfo
lbi) Verbosity
verbosity
                   -- source files
                   -- suboptimal: UHC does not understand module names, so
                   -- we replace periods by path separators
                forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map (forall a b. (a -> b) -> [a] -> [b]
map (\ Char
c -> if Char
c forall a. Eq a => a -> a -> Bool
== Char
'.' then Char
pathSeparator else Char
c))
                       (forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> FilePath
prettyShow (Library -> ComponentLocalBuildInfo -> [ModuleName]
allLibModules Library
lib ComponentLocalBuildInfo
clbi))

  [FilePath] -> IO ()
runUhcProg [FilePath]
uhcArgs

  forall (m :: * -> *) a. Monad m => a -> m a
return ()

buildExe :: Verbosity -> PackageDescription -> LocalBuildInfo
                      -> Executable         -> ComponentLocalBuildInfo -> IO ()
buildExe :: Verbosity
-> PackageDescription
-> LocalBuildInfo
-> Executable
-> ComponentLocalBuildInfo
-> IO ()
buildExe Verbosity
verbosity PackageDescription
_pkg_descr LocalBuildInfo
lbi Executable
exe ComponentLocalBuildInfo
clbi = do
  FilePath
systemPkgDir <- Verbosity -> ProgramDb -> IO FilePath
getGlobalPackageDir Verbosity
verbosity (LocalBuildInfo -> ProgramDb
withPrograms LocalBuildInfo
lbi)
  FilePath
userPkgDir   <- IO FilePath
getUserPackageDir
  let runUhcProg :: [FilePath] -> IO ()
runUhcProg = Verbosity -> Program -> ProgramDb -> [FilePath] -> IO ()
runDbProgram Verbosity
verbosity Program
uhcProgram (LocalBuildInfo -> ProgramDb
withPrograms LocalBuildInfo
lbi)
  let uhcArgs :: [FilePath]
uhcArgs =    -- common flags lib/exe
                   FilePath
-> FilePath
-> LocalBuildInfo
-> BuildInfo
-> ComponentLocalBuildInfo
-> FilePath
-> Verbosity
-> [FilePath]
constructUHCCmdLine FilePath
userPkgDir FilePath
systemPkgDir
                                       LocalBuildInfo
lbi (Executable -> BuildInfo
buildInfo Executable
exe) ComponentLocalBuildInfo
clbi
                                       (LocalBuildInfo -> FilePath
buildDir LocalBuildInfo
lbi) Verbosity
verbosity
                   -- output file
                forall a. [a] -> [a] -> [a]
++ [FilePath
"--output", LocalBuildInfo -> FilePath
buildDir LocalBuildInfo
lbi FilePath -> FilePath -> FilePath
</> forall a. Pretty a => a -> FilePath
prettyShow (Executable -> UnqualComponentName
exeName Executable
exe)]
                   -- main source module
                forall a. [a] -> [a] -> [a]
++ [Executable -> FilePath
modulePath Executable
exe]
  [FilePath] -> IO ()
runUhcProg [FilePath]
uhcArgs

constructUHCCmdLine :: FilePath -> FilePath
                    -> LocalBuildInfo -> BuildInfo -> ComponentLocalBuildInfo
                    -> FilePath -> Verbosity -> [String]
constructUHCCmdLine :: FilePath
-> FilePath
-> LocalBuildInfo
-> BuildInfo
-> ComponentLocalBuildInfo
-> FilePath
-> Verbosity
-> [FilePath]
constructUHCCmdLine FilePath
user FilePath
system LocalBuildInfo
lbi BuildInfo
bi ComponentLocalBuildInfo
clbi FilePath
odir Verbosity
verbosity =
     -- verbosity
     (if      Verbosity
verbosity forall a. Ord a => a -> a -> Bool
>= Verbosity
deafening then [FilePath
"-v4"]
      else if Verbosity
verbosity forall a. Ord a => a -> a -> Bool
>= Verbosity
normal    then []
      else                                [FilePath
"-v0"])
  forall a. [a] -> [a] -> [a]
++ CompilerFlavor -> BuildInfo -> [FilePath]
hcOptions CompilerFlavor
UHC BuildInfo
bi
     -- flags for language extensions
  forall a. [a] -> [a] -> [a]
++ Compiler -> Maybe Language -> [FilePath]
languageToFlags   (LocalBuildInfo -> Compiler
compiler LocalBuildInfo
lbi) (BuildInfo -> Maybe Language
defaultLanguage BuildInfo
bi)
  forall a. [a] -> [a] -> [a]
++ Compiler -> [Extension] -> [FilePath]
extensionsToFlags (LocalBuildInfo -> Compiler
compiler LocalBuildInfo
lbi) (BuildInfo -> [Extension]
usedExtensions BuildInfo
bi)
     -- packages
  forall a. [a] -> [a] -> [a]
++ [FilePath
"--hide-all-packages"]
  forall a. [a] -> [a] -> [a]
++ FilePath -> FilePath -> PackageDBStack -> [FilePath]
uhcPackageDbOptions FilePath
user FilePath
system (LocalBuildInfo -> PackageDBStack
withPackageDB LocalBuildInfo
lbi)
  forall a. [a] -> [a] -> [a]
++ [FilePath
"--package=uhcbase"]
  forall a. [a] -> [a] -> [a]
++ [FilePath
"--package=" forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> FilePath
prettyShow (MungedPackageId -> MungedPackageName
mungedName MungedPackageId
pkgid) | (UnitId
_, MungedPackageId
pkgid) <- ComponentLocalBuildInfo -> [(UnitId, MungedPackageId)]
componentPackageDeps ComponentLocalBuildInfo
clbi ]
     -- search paths
  forall a. [a] -> [a] -> [a]
++ [FilePath
"-i" forall a. [a] -> [a] -> [a]
++ FilePath
odir]
  forall a. [a] -> [a] -> [a]
++ [FilePath
"-i" forall a. [a] -> [a] -> [a]
++ forall from to. SymbolicPath from to -> FilePath
getSymbolicPath SymbolicPath PackageDir SourceDir
l | SymbolicPath PackageDir SourceDir
l <- forall a. Eq a => [a] -> [a]
nub (BuildInfo -> [SymbolicPath PackageDir SourceDir]
hsSourceDirs BuildInfo
bi)]
  forall a. [a] -> [a] -> [a]
++ [FilePath
"-i" forall a. [a] -> [a] -> [a]
++ LocalBuildInfo -> ComponentLocalBuildInfo -> FilePath
autogenComponentModulesDir LocalBuildInfo
lbi ComponentLocalBuildInfo
clbi]
  forall a. [a] -> [a] -> [a]
++ [FilePath
"-i" forall a. [a] -> [a] -> [a]
++ LocalBuildInfo -> FilePath
autogenPackageModulesDir LocalBuildInfo
lbi]
     -- cpp options
  forall a. [a] -> [a] -> [a]
++ [FilePath
"--optP=" forall a. [a] -> [a] -> [a]
++ FilePath
opt | FilePath
opt <- BuildInfo -> [FilePath]
cppOptions BuildInfo
bi]
     -- output path
  forall a. [a] -> [a] -> [a]
++ [FilePath
"--odir=" forall a. [a] -> [a] -> [a]
++ FilePath
odir]
     -- optimization
  forall a. [a] -> [a] -> [a]
++ (case LocalBuildInfo -> OptimisationLevel
withOptimization LocalBuildInfo
lbi of
        OptimisationLevel
NoOptimisation       ->  [FilePath
"-O0"]
        OptimisationLevel
NormalOptimisation   ->  [FilePath
"-O1"]
        OptimisationLevel
MaximumOptimisation  ->  [FilePath
"-O2"])

uhcPackageDbOptions :: FilePath -> FilePath -> PackageDBStack -> [String]
uhcPackageDbOptions :: FilePath -> FilePath -> PackageDBStack -> [FilePath]
uhcPackageDbOptions FilePath
user FilePath
system PackageDBStack
db = forall a b. (a -> b) -> [a] -> [b]
map (\ FilePath
x -> FilePath
"--pkg-searchpath=" forall a. [a] -> [a] -> [a]
++ FilePath
x)
                                         (forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (FilePath -> FilePath -> PackageDB -> [FilePath]
packageDbPaths FilePath
user FilePath
system) PackageDBStack
db)

-- -----------------------------------------------------------------------------
-- Installation

installLib :: Verbosity -> LocalBuildInfo
           -> FilePath -> FilePath -> FilePath
           -> PackageDescription -> Library -> ComponentLocalBuildInfo -> IO ()
installLib :: Verbosity
-> LocalBuildInfo
-> FilePath
-> FilePath
-> FilePath
-> PackageDescription
-> Library
-> ComponentLocalBuildInfo
-> IO ()
installLib Verbosity
verbosity LocalBuildInfo
_lbi FilePath
targetDir FilePath
_dynlibTargetDir FilePath
builtDir PackageDescription
pkg Library
_library ComponentLocalBuildInfo
_clbi = do
    -- putStrLn $ "dest:  " ++ targetDir
    -- putStrLn $ "built: " ++ builtDir
    Verbosity -> FilePath -> FilePath -> IO ()
installDirectoryContents Verbosity
verbosity (FilePath
builtDir FilePath -> FilePath -> FilePath
</> forall a. Pretty a => a -> FilePath
prettyShow (forall pkg. Package pkg => pkg -> PackageIdentifier
packageId PackageDescription
pkg)) FilePath
targetDir

-- currently hard-coded UHC code generator and variant to use
uhcTarget, uhcTargetVariant :: String
uhcTarget :: FilePath
uhcTarget        = FilePath
"bc"
uhcTargetVariant :: FilePath
uhcTargetVariant = FilePath
"plain"

-- root directory for a package in UHC
uhcPackageDir    :: String -> String -> FilePath
uhcPackageSubDir ::           String -> FilePath
uhcPackageDir :: FilePath -> FilePath -> FilePath
uhcPackageDir    FilePath
pkgid FilePath
compilerid = FilePath
pkgid FilePath -> FilePath -> FilePath
</> FilePath -> FilePath
uhcPackageSubDir FilePath
compilerid
uhcPackageSubDir :: FilePath -> FilePath
uhcPackageSubDir       FilePath
compilerid = FilePath
compilerid FilePath -> FilePath -> FilePath
</> FilePath
uhcTarget FilePath -> FilePath -> FilePath
</> FilePath
uhcTargetVariant

-- -----------------------------------------------------------------------------
-- Registering

registerPackage
  :: Verbosity
  -> Compiler
  -> ProgramDb
  -> PackageDBStack
  -> InstalledPackageInfo
  -> IO ()
registerPackage :: Verbosity
-> Compiler
-> ProgramDb
-> PackageDBStack
-> InstalledPackageInfo
-> IO ()
registerPackage Verbosity
verbosity Compiler
comp ProgramDb
progdb PackageDBStack
packageDbs InstalledPackageInfo
installedPkgInfo = do
    FilePath
dbdir <- case PackageDBStack -> PackageDB
registrationPackageDB PackageDBStack
packageDbs of
      PackageDB
GlobalPackageDB       -> Verbosity -> ProgramDb -> IO FilePath
getGlobalPackageDir Verbosity
verbosity ProgramDb
progdb
      PackageDB
UserPackageDB         -> IO FilePath
getUserPackageDir
      SpecificPackageDB FilePath
dir -> forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
dir
    let pkgdir :: FilePath
pkgdir = FilePath
dbdir FilePath -> FilePath -> FilePath
</> FilePath -> FilePath -> FilePath
uhcPackageDir (forall a. Pretty a => a -> FilePath
prettyShow PackageIdentifier
pkgid) (forall a. Pretty a => a -> FilePath
prettyShow CompilerId
compilerid)
    Verbosity -> Bool -> FilePath -> IO ()
createDirectoryIfMissingVerbose Verbosity
verbosity Bool
True FilePath
pkgdir
    FilePath -> FilePath -> IO ()
writeUTF8File (FilePath
pkgdir FilePath -> FilePath -> FilePath
</> FilePath
installedPkgConfig)
                  (InstalledPackageInfo -> FilePath
showInstalledPackageInfo InstalledPackageInfo
installedPkgInfo)
  where
    pkgid :: PackageIdentifier
pkgid      = InstalledPackageInfo -> PackageIdentifier
sourcePackageId InstalledPackageInfo
installedPkgInfo
    compilerid :: CompilerId
compilerid = Compiler -> CompilerId
compilerId Compiler
comp

inplacePackageDbPath :: LocalBuildInfo -> FilePath
inplacePackageDbPath :: LocalBuildInfo -> FilePath
inplacePackageDbPath LocalBuildInfo
lbi = LocalBuildInfo -> FilePath
buildDir LocalBuildInfo
lbi