    {-# 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 = mkLegacyUnitId p,
        sourcePackageId = 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