{-# 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 as C
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 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
-> AbiTag
-> [CompilerId]
-> [(Language, FilePath)]
-> [(Extension, Maybe FilePath)]
-> Map FilePath FilePath
-> Compiler
Compiler {
               compilerId :: CompilerId
compilerId         =  CompilerFlavor -> Version -> CompilerId
CompilerId CompilerFlavor
UHC Version
uhcVersion,
               compilerAbiTag :: AbiTag
compilerAbiTag     =  AbiTag
C.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 =  Map FilePath FilePath
forall k a. Map k a
Map.empty
             }
      compPlatform :: Maybe a
compPlatform = Maybe a
forall a. Maybe a
Nothing
  (Compiler, Maybe Platform, ProgramDb)
-> IO (Compiler, Maybe Platform, ProgramDb)
forall (m :: * -> *) a. Monad m => a -> m a
return (Compiler
comp, Maybe Platform
forall a. Maybe a
compPlatform, ProgramDb
progdb')

uhcLanguages :: [(Language, C.Flag)]
uhcLanguages :: [(Language, FilePath)]
uhcLanguages = [(Language
Haskell98, FilePath
"")]

-- | The flags for the supported extensions.
uhcLanguageExtensions :: [(Extension, Maybe C.Flag)]
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 = (Maybe a
forall a. Maybe a
Nothing, Maybe a
forall a. Maybe a
Nothing{- wrong -})
    in ((KnownExtension, (Maybe FilePath, Maybe FilePath))
 -> [(Extension, Maybe FilePath)])
-> [(KnownExtension, (Maybe FilePath, Maybe FilePath))]
-> [(Extension, Maybe FilePath)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (KnownExtension, (Maybe FilePath, Maybe FilePath))
-> [(Extension, Maybe FilePath)]
forall b. (KnownExtension, (b, b)) -> [(Extension, b)]
doFlag
    [(KnownExtension
CPP,                          (FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
"--cpp", Maybe FilePath
forall a. Maybe a
Nothing{- wrong -})),
     (KnownExtension
PolymorphicComponents,        (Maybe FilePath, Maybe FilePath)
forall a a. (Maybe a, Maybe a)
alwaysOn),
     (KnownExtension
ExistentialQuantification,    (Maybe FilePath, Maybe FilePath)
forall a a. (Maybe a, Maybe a)
alwaysOn),
     (KnownExtension
ForeignFunctionInterface,     (Maybe FilePath, Maybe FilePath)
forall a a. (Maybe a, Maybe a)
alwaysOn),
     (KnownExtension
UndecidableInstances,         (Maybe FilePath, Maybe FilePath)
forall a a. (Maybe a, Maybe a)
alwaysOn),
     (KnownExtension
MultiParamTypeClasses,        (Maybe FilePath, Maybe FilePath)
forall a a. (Maybe a, Maybe a)
alwaysOn),
     (KnownExtension
Rank2Types,                   (Maybe FilePath, Maybe FilePath)
forall a a. (Maybe a, Maybe a)
alwaysOn),
     (KnownExtension
PatternSignatures,            (Maybe FilePath, Maybe FilePath)
forall a a. (Maybe a, Maybe a)
alwaysOn),
     (KnownExtension
EmptyDataDecls,               (Maybe FilePath, Maybe FilePath)
forall a a. (Maybe a, Maybe a)
alwaysOn),
     (KnownExtension
ImplicitPrelude,              (Maybe FilePath
forall a. Maybe a
Nothing, FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
"--no-prelude"{- wrong -})),
     (KnownExtension
TypeOperators,                (Maybe FilePath, Maybe FilePath)
forall a a. (Maybe a, Maybe a)
alwaysOn),
     (KnownExtension
OverlappingInstances,         (Maybe FilePath, Maybe FilePath)
forall a a. (Maybe a, Maybe a)
alwaysOn),
     (KnownExtension
FlexibleInstances,            (Maybe FilePath, Maybe FilePath)
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    = [FilePath] -> [FilePath]
forall a. Eq a => [a] -> [a]
nub ((PackageDB -> [FilePath]) -> PackageDBStack -> [FilePath]
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 <- ([[FilePath]] -> [FilePath]) -> IO [[FilePath]] -> IO [FilePath]
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM ((FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> FilePath
addBuiltinVersions ([FilePath] -> [FilePath])
-> ([[FilePath]] -> [FilePath]) -> [[FilePath]] -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[FilePath]] -> [FilePath]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat) (IO [[FilePath]] -> IO [FilePath])
-> IO [[FilePath]] -> IO [FilePath]
forall a b. (a -> b) -> a -> b
$
          (FilePath -> IO [FilePath]) -> [FilePath] -> IO [[FilePath]]
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 IO [FilePath] -> ([FilePath] -> IO [FilePath]) -> IO [FilePath]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (FilePath -> IO Bool) -> [FilePath] -> IO [FilePath]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM (FilePath -> FilePath -> FilePath -> IO Bool
isPkgDir (CompilerId -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow CompilerId
compilerid) FilePath
d))
          [FilePath]
pkgDirs
  -- putStrLn $ "pkgs: " ++ show pkgs
  let iPkgs :: [InstalledPackageInfo]
iPkgs =
        (PackageId -> InstalledPackageInfo)
-> [PackageId] -> [InstalledPackageInfo]
forall a b. (a -> b) -> [a] -> [b]
map PackageId -> InstalledPackageInfo
mkInstalledPackageInfo ([PackageId] -> [InstalledPackageInfo])
-> [PackageId] -> [InstalledPackageInfo]
forall a b. (a -> b) -> a -> b
$
        (FilePath -> [PackageId]) -> [FilePath] -> [PackageId]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap FilePath -> [PackageId]
parsePackage ([FilePath] -> [PackageId]) -> [FilePath] -> [PackageId]
forall a b. (a -> b) -> a -> b
$
        [FilePath]
pkgs
  -- putStrLn $ "installed pkgs: " ++ show iPkgs
  InstalledPackageIndex -> IO InstalledPackageIndex
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
    FilePath -> IO FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
pkgdir
  where
    trimEnd :: FilePath -> FilePath
trimEnd = FilePath -> FilePath
forall a. [a] -> [a]
reverse (FilePath -> FilePath)
-> (FilePath -> FilePath) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> FilePath -> FilePath
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace (FilePath -> FilePath)
-> (FilePath -> FilePath) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
forall a. [a] -> [a]
reverse

getUserPackageDir :: NoCallStackIO FilePath
getUserPackageDir :: IO FilePath
getUserPackageDir = do
    FilePath
homeDir <- IO FilePath
getHomeDirectory
    FilePath -> IO FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath -> IO FilePath) -> FilePath -> IO FilePath
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 -> NoCallStackIO Bool
isPkgDir :: FilePath -> FilePath -> FilePath -> IO Bool
isPkgDir FilePath
_ FilePath
_   (Char
'.' : FilePath
_)  = Bool -> IO Bool
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 -> [PackageId]
parsePackage = Maybe PackageId -> [PackageId]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList  (Maybe PackageId -> [PackageId])
-> (FilePath -> Maybe PackageId) -> FilePath -> [PackageId]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Maybe PackageId
forall a. Parsec a => FilePath -> Maybe a
simpleParsec

-- | Create a trivial package info from a directory name.
mkInstalledPackageInfo :: PackageId -> InstalledPackageInfo
mkInstalledPackageInfo :: PackageId -> InstalledPackageInfo
mkInstalledPackageInfo PackageId
p = InstalledPackageInfo
emptyInstalledPackageInfo
  { installedUnitId :: UnitId
installedUnitId = PackageId -> UnitId
mkLegacyUnitId PackageId
p,
    sourcePackageId :: PackageId
sourcePackageId = PackageId
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=" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ PackageId -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow (PackageDescription -> PackageId
forall pkg. Package pkg => pkg -> PackageId
packageId PackageDescription
pkg_descr)]
                   -- common flags lib/exe
                [FilePath] -> [FilePath] -> [FilePath]
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
                [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map ((Char -> Char) -> FilePath -> FilePath
forall a b. (a -> b) -> [a] -> [b]
map (\ Char
c -> if Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.' then Char
pathSeparator else Char
c))
                       ((ModuleName -> FilePath) -> [ModuleName] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map ModuleName -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow (Library -> ComponentLocalBuildInfo -> [ModuleName]
allLibModules Library
lib ComponentLocalBuildInfo
clbi))

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

  () -> IO ()
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
                [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath
"--output", LocalBuildInfo -> FilePath
buildDir LocalBuildInfo
lbi FilePath -> FilePath -> FilePath
</> UnqualComponentName -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow (Executable -> UnqualComponentName
exeName Executable
exe)]
                   -- main source module
                [FilePath] -> [FilePath] -> [FilePath]
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 Verbosity -> Verbosity -> Bool
forall a. Ord a => a -> a -> Bool
>= Verbosity
deafening then [FilePath
"-v4"]
      else if Verbosity
verbosity Verbosity -> Verbosity -> Bool
forall a. Ord a => a -> a -> Bool
>= Verbosity
normal    then []
      else                                [FilePath
"-v0"])
  [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ CompilerFlavor -> BuildInfo -> [FilePath]
hcOptions CompilerFlavor
UHC BuildInfo
bi
     -- flags for language extensions
  [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ Compiler -> Maybe Language -> [FilePath]
languageToFlags   (LocalBuildInfo -> Compiler
compiler LocalBuildInfo
lbi) (BuildInfo -> Maybe Language
defaultLanguage BuildInfo
bi)
  [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ Compiler -> [Extension] -> [FilePath]
extensionsToFlags (LocalBuildInfo -> Compiler
compiler LocalBuildInfo
lbi) (BuildInfo -> [Extension]
usedExtensions BuildInfo
bi)
     -- packages
  [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath
"--hide-all-packages"]
  [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ FilePath -> FilePath -> PackageDBStack -> [FilePath]
uhcPackageDbOptions FilePath
user FilePath
system (LocalBuildInfo -> PackageDBStack
withPackageDB LocalBuildInfo
lbi)
  [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath
"--package=uhcbase"]
  [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath
"--package=" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ MungedPackageName -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow (MungedPackageId -> MungedPackageName
mungedName MungedPackageId
pkgid) | (UnitId
_, MungedPackageId
pkgid) <- ComponentLocalBuildInfo -> [(UnitId, MungedPackageId)]
componentPackageDeps ComponentLocalBuildInfo
clbi ]
     -- search paths
  [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath
"-i" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
odir]
  [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath
"-i" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
l | FilePath
l <- [FilePath] -> [FilePath]
forall a. Eq a => [a] -> [a]
nub (BuildInfo -> [FilePath]
hsSourceDirs BuildInfo
bi)]
  [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath
"-i" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ LocalBuildInfo -> ComponentLocalBuildInfo -> FilePath
autogenComponentModulesDir LocalBuildInfo
lbi ComponentLocalBuildInfo
clbi]
  [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath
"-i" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ LocalBuildInfo -> FilePath
autogenPackageModulesDir LocalBuildInfo
lbi]
     -- cpp options
  [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath
"--optP=" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
opt | FilePath
opt <- BuildInfo -> [FilePath]
cppOptions BuildInfo
bi]
     -- output path
  [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath
"--odir=" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
odir]
     -- optimization
  [FilePath] -> [FilePath] -> [FilePath]
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 = (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (\ FilePath
x -> FilePath
"--pkg-searchpath=" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
x)
                                         ((PackageDB -> [FilePath]) -> PackageDBStack -> [FilePath]
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
</> PackageId -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow (PackageDescription -> PackageId
forall pkg. Package pkg => pkg -> PackageId
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 -> FilePath -> IO FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
dir
    let pkgdir :: FilePath
pkgdir = FilePath
dbdir FilePath -> FilePath -> FilePath
</> FilePath -> FilePath -> FilePath
uhcPackageDir (PackageId -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow PackageId
pkgid) (CompilerId -> FilePath
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 :: PackageId
pkgid      = InstalledPackageInfo -> PackageId
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