{-# 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 =  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 a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Compiler
comp, Maybe Platform
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 = (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)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (\ FilePath
d -> FilePath -> IO [FilePath]
getDirectoryContents FilePath
d IO [FilePath] -> ([FilePath] -> IO [FilePath]) -> IO [FilePath]
forall a b. IO a -> (a -> IO b) -> IO b
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 =
        (PackageIdentifier -> InstalledPackageInfo)
-> [PackageIdentifier] -> [InstalledPackageInfo]
forall a b. (a -> b) -> [a] -> [b]
map PackageIdentifier -> InstalledPackageInfo
mkInstalledPackageInfo ([PackageIdentifier] -> [InstalledPackageInfo])
-> [PackageIdentifier] -> [InstalledPackageInfo]
forall a b. (a -> b) -> a -> b
$
        (FilePath -> [PackageIdentifier])
-> [FilePath] -> [PackageIdentifier]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap FilePath -> [PackageIdentifier]
parsePackage ([FilePath] -> [PackageIdentifier])
-> [FilePath] -> [PackageIdentifier]
forall a b. (a -> b) -> a -> b
$
        [FilePath]
pkgs
  -- putStrLn $ "installed pkgs: " ++ show iPkgs
  InstalledPackageIndex -> IO InstalledPackageIndex
forall a. a -> IO a
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 a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
pkgdir
  where
    trimEnd :: FilePath -> FilePath
trimEnd = (Char -> Bool) -> FilePath -> FilePath
forall a. (a -> Bool) -> [a] -> [a]
dropWhileEnd Char -> Bool
isSpace

getUserPackageDir :: IO FilePath
getUserPackageDir :: IO FilePath
getUserPackageDir = do
    FilePath
homeDir <- IO FilePath
getHomeDirectory
    FilePath -> IO FilePath
forall a. a -> IO a
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 -> IO Bool
isPkgDir :: FilePath -> FilePath -> FilePath -> IO Bool
isPkgDir FilePath
_ FilePath
_   (Char
'.' : FilePath
_)  = Bool -> IO Bool
forall a. a -> IO a
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 = Maybe PackageIdentifier -> [PackageIdentifier]
forall a. Maybe a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList  (Maybe PackageIdentifier -> [PackageIdentifier])
-> (FilePath -> Maybe PackageIdentifier)
-> FilePath
-> [PackageIdentifier]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Maybe PackageIdentifier
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=" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ PackageIdentifier -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow (PackageDescription -> PackageIdentifier
forall pkg. Package pkg => pkg -> PackageIdentifier
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 a. a -> IO a
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]
++ SymbolicPath PackageDir SourceDir -> FilePath
forall from to. SymbolicPath from to -> FilePath
getSymbolicPath SymbolicPath PackageDir SourceDir
l | SymbolicPath PackageDir SourceDir
l <- [SymbolicPath PackageDir SourceDir]
-> [SymbolicPath PackageDir SourceDir]
forall a. Eq a => [a] -> [a]
nub (BuildInfo -> [SymbolicPath PackageDir SourceDir]
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
</> PackageIdentifier -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow (PackageDescription -> PackageIdentifier
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 -> FilePath -> IO FilePath
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
dir
    let pkgdir :: FilePath
pkgdir = FilePath
dbdir FilePath -> FilePath -> FilePath
</> FilePath -> FilePath -> FilePath
uhcPackageDir (PackageIdentifier -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow PackageIdentifier
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 :: 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