{-# LANGUAGE CPP #-}
--
-- Copyright (C) 2004-5 Don Stewart - http://www.cse.unsw.edu.au/~dons
--
-- This library is free software; you can redistribute it and/or
-- modify it under the terms of the GNU Lesser General Public
-- License as published by the Free Software Foundation; either
-- version 2.1 of the License, or (at your option) any later version.
--
-- This library is distributed in the hope that it will be useful,
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-- Lesser General Public License for more details.
--
-- You should have received a copy of the GNU Lesser General Public
-- License along with this library; if not, write to the Free Software
-- Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307
-- USA
--

module System.Plugins.Env (
        env,
        withModEnv,
        withDepEnv,
        withPkgEnvs,
        withMerged,
        modifyModEnv,
        modifyDepEnv,
        modifyPkgEnv,
        modifyMerged,
        addModule,
        rmModule,
        addModules,
        isLoaded,
        loaded,
        addModuleDeps,
        getModuleDeps,
        rmModuleDeps,
        isMerged,
        lookupMerged,
        addMerge,
        addPkgConf,
        defaultPkgConf,
        union,
        addStaticPkg,
        isStaticPkg,
        rmStaticPkg,
        grabDefaultPkgConf,
        readPackageConf,
        lookupPkg,
        pkgManglingPrefix

   ) where

#include "config.h"

import System.Plugins.LoadTypes (Module)
import System.Plugins.Consts           ( sysPkgSuffix )

import Control.Monad            ( liftM )

import Data.IORef               ( writeIORef, readIORef, newIORef, IORef() )
import Data.Maybe               ( isJust, isNothing, fromMaybe )
import Data.List                ( (\\), nub )

import System.IO.Unsafe         ( unsafePerformIO )
import System.Directory         ( doesFileExist )
#if defined(CYGWIN) || defined(__MINGW32__)
import Prelude hiding ( catch, ioError )
import System.IO.Error          ( catch, ioError, isDoesNotExistError )
#endif

import Control.Concurrent.MVar  ( MVar(), newMVar, withMVar )

import GHC.Paths (libdir)
import DynFlags (
#if MIN_VERSION_ghc(7,8,0)
  Way(WayDyn), dynamicGhc, ways,
#endif
  defaultDynFlags, initDynFlags)
import SysTools ( initSysTools
#if MIN_VERSION_ghc(8,10,1)
                , lazyInitLlvmConfig
#else
                , initLlvmConfig
#endif
  )

import Distribution.Package hiding (
#if MIN_VERSION_ghc(7,6,0)
                                     Module,
#endif
                                     depends, packageName, PackageName(..)
                                   , installedUnitId
#if MIN_VERSION_ghc(7,10,0)
                                   , installedPackageId
#endif
  )
import Distribution.Text

import Distribution.InstalledPackageInfo
import Distribution.Simple.Compiler
import Distribution.Simple.GHC
import Distribution.Simple.PackageIndex
import Distribution.Simple.Program
import Distribution.Verbosity

import System.Environment
import Data.List.Split

import qualified Data.Map as M
import qualified Data.Set as S

#if !MIN_VERSION_ghc(8,10,1)
lazyInitLlvmConfig = initLlvmConfig
#endif

--
-- and map Data.Map terms to FiniteMap terms
--
type FiniteMap k e = M.Map k e

emptyFM :: FiniteMap key elt
emptyFM :: FiniteMap key elt
emptyFM   = FiniteMap key elt
forall k a. Map k a
M.empty

addToFM :: (Ord key) => FiniteMap key elt -> key -> elt -> FiniteMap key elt
addToFM :: FiniteMap key elt -> key -> elt -> FiniteMap key elt
addToFM   = \FiniteMap key elt
m key
k elt
e -> key -> elt -> FiniteMap key elt -> FiniteMap key elt
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert key
k elt
e FiniteMap key elt
m

addWithFM :: (Ord key)
          => (elt -> elt -> elt) -> FiniteMap key elt -> key -> elt -> FiniteMap key elt
addWithFM :: (elt -> elt -> elt)
-> FiniteMap key elt -> key -> elt -> FiniteMap key elt
addWithFM   = \elt -> elt -> elt
comb FiniteMap key elt
m key
k elt
e -> (elt -> elt -> elt)
-> key -> elt -> FiniteMap key elt -> FiniteMap key elt
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
M.insertWith elt -> elt -> elt
comb key
k elt
e FiniteMap key elt
m

delFromFM :: (Ord key) => FiniteMap key elt -> key -> FiniteMap key elt
delFromFM :: FiniteMap key elt -> key -> FiniteMap key elt
delFromFM = (key -> FiniteMap key elt -> FiniteMap key elt)
-> FiniteMap key elt -> key -> FiniteMap key elt
forall a b c. (a -> b -> c) -> b -> a -> c
flip key -> FiniteMap key elt -> FiniteMap key elt
forall k a. Ord k => k -> Map k a -> Map k a
M.delete

lookupFM :: (Ord key) => FiniteMap key elt -> key -> Maybe elt
lookupFM :: FiniteMap key elt -> key -> Maybe elt
lookupFM  = (key -> FiniteMap key elt -> Maybe elt)
-> FiniteMap key elt -> key -> Maybe elt
forall a b c. (a -> b -> c) -> b -> a -> c
flip key -> FiniteMap key elt -> Maybe elt
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup

--
-- | We need to record what modules and packages we have loaded, so if
-- we read a .hi file that wants to load something already loaded, we
-- can safely ignore that request. We're in the IO monad anyway, so we
-- can add some extra state of our own.
--
-- The state is a FiniteMap String (Module,Int) (a hash of
-- package\/object names to Modules and how many times they've been
-- loaded).
--
-- It also contains the package.conf information, so that if there is a
-- package dependency we can find it correctly, even if it has a
-- non-standard path or name, and if it isn't an official package (but
-- rather one provided via -package-conf). This is stored as a FiniteMap
-- PackageName PackageConfig. The problem then is whether a user's
-- package.conf, that uses the same package name as an existing GHC
-- package, should be allowed, or should shadow a library package?  I
-- don't know, but I'm inclined to have the GHC package shadow the
-- user's package.
--
-- This idea is based on /Hampus Ram's dynamic loader/ dependency
-- tracking system. He uses state to record dependency trees to allow
-- clean unloading and other fun. This is quite cool. We're just using
-- state to make sure we don't load the same package twice. Implementing
-- the full dependency tree idea would be nice, though not fully
-- necessary as we have the dependency information store in .hi files,
-- unlike in hram's loader.
--

type ModEnv = FiniteMap String (Module,Int)

type DepEnv = FiniteMap Module [Module]

-- represents a package.conf file
type PkgEnv  = FiniteMap PackageName PackageConfig

type StaticPkgEnv = S.Set PackageName

-- record dependencies between (src,stub) -> merged modid
type MergeEnv = FiniteMap (FilePath,FilePath) FilePath

-- multiple package.conf's kept in separate namespaces
type PkgEnvs = [PkgEnv]

type Env = (MVar (),
            IORef ModEnv,
            IORef DepEnv,
            IORef PkgEnvs,
            IORef StaticPkgEnv,
            IORef MergeEnv)


--
-- our environment, contains a set of loaded objects, and a map of known
-- packages and their information. Initially all we know is the default
-- package.conf information.
--
env :: (MVar (), IORef (FiniteMap key elt), IORef (FiniteMap key elt),
 IORef PkgEnvs, IORef (Set [Char]), IORef (FiniteMap key elt))
env = IO
  (MVar (), IORef (FiniteMap key elt), IORef (FiniteMap key elt),
   IORef PkgEnvs, IORef (Set [Char]), IORef (FiniteMap key elt))
-> (MVar (), IORef (FiniteMap key elt), IORef (FiniteMap key elt),
    IORef PkgEnvs, IORef (Set [Char]), IORef (FiniteMap key elt))
forall a. IO a -> a
unsafePerformIO (IO
   (MVar (), IORef (FiniteMap key elt), IORef (FiniteMap key elt),
    IORef PkgEnvs, IORef (Set [Char]), IORef (FiniteMap key elt))
 -> (MVar (), IORef (FiniteMap key elt), IORef (FiniteMap key elt),
     IORef PkgEnvs, IORef (Set [Char]), IORef (FiniteMap key elt)))
-> IO
     (MVar (), IORef (FiniteMap key elt), IORef (FiniteMap key elt),
      IORef PkgEnvs, IORef (Set [Char]), IORef (FiniteMap key elt))
-> (MVar (), IORef (FiniteMap key elt), IORef (FiniteMap key elt),
    IORef PkgEnvs, IORef (Set [Char]), IORef (FiniteMap key elt))
forall a b. (a -> b) -> a -> b
$ do
                MVar ()
mvar  <- () -> IO (MVar ())
forall a. a -> IO (MVar a)
newMVar ()
                IORef (FiniteMap key elt)
ref1  <- FiniteMap key elt -> IO (IORef (FiniteMap key elt))
forall a. a -> IO (IORef a)
newIORef FiniteMap key elt
forall k a. Map k a
emptyFM         -- loaded objects
                IORef (FiniteMap key elt)
ref2  <- FiniteMap key elt -> IO (IORef (FiniteMap key elt))
forall a. a -> IO (IORef a)
newIORef FiniteMap key elt
forall k a. Map k a
emptyFM
                PkgEnvs
p     <- IO PkgEnvs
grabDefaultPkgConf
                IORef PkgEnvs
ref3  <- PkgEnvs -> IO (IORef PkgEnvs)
forall a. a -> IO (IORef a)
newIORef PkgEnvs
p               -- package.conf info
                IORef (Set [Char])
ref4  <- Set [Char] -> IO (IORef (Set [Char]))
forall a. a -> IO (IORef a)
newIORef ([[Char]] -> Set [Char]
forall a. Ord a => [a] -> Set a
S.fromList [[Char]
"base",[Char]
"Cabal",[Char]
"haskell-src", [Char]
"containers",
                                               [Char]
"arrays", [Char]
"directory", [Char]
"random", [Char]
"process",
                                               [Char]
"ghc", [Char]
"ghc-prim"])
                IORef (FiniteMap key elt)
ref5  <- FiniteMap key elt -> IO (IORef (FiniteMap key elt))
forall a. a -> IO (IORef a)
newIORef FiniteMap key elt
forall k a. Map k a
emptyFM         -- merged files
                (MVar (), IORef (FiniteMap key elt), IORef (FiniteMap key elt),
 IORef PkgEnvs, IORef (Set [Char]), IORef (FiniteMap key elt))
-> IO
     (MVar (), IORef (FiniteMap key elt), IORef (FiniteMap key elt),
      IORef PkgEnvs, IORef (Set [Char]), IORef (FiniteMap key elt))
forall (m :: * -> *) a. Monad m => a -> m a
return (MVar ()
mvar, IORef (FiniteMap key elt)
ref1, IORef (FiniteMap key elt)
ref2, IORef PkgEnvs
ref3, IORef (Set [Char])
ref4, IORef (FiniteMap key elt)
ref5)
{-# NOINLINE env #-}

-- -----------------------------------------------------------
--
-- | apply 'f' to the loaded objects Env, apply 'f' to the package.conf
-- FM /locks up the MVar/ so you can't recursively call a function
-- inside a with any -Env function. Nice and threadsafe
--
withModEnv  :: Env -> (ModEnv   -> IO a) -> IO a
withDepEnv  :: Env -> (DepEnv   -> IO a) -> IO a
withPkgEnvs :: Env -> (PkgEnvs  -> IO a) -> IO a
withStaticPkgEnv :: Env -> (StaticPkgEnv -> IO a) -> IO a
withMerged  :: Env -> (MergeEnv -> IO a) -> IO a

withModEnv :: Env -> (ModEnv -> IO a) -> IO a
withModEnv  (MVar ()
mvar,IORef ModEnv
ref,IORef DepEnv
_,IORef PkgEnvs
_,IORef (Set [Char])
_,IORef MergeEnv
_) ModEnv -> IO a
f = MVar () -> (() -> IO a) -> IO a
forall a b. MVar a -> (a -> IO b) -> IO b
withMVar MVar ()
mvar (\()
_ -> IORef ModEnv -> IO ModEnv
forall a. IORef a -> IO a
readIORef IORef ModEnv
ref IO ModEnv -> (ModEnv -> IO a) -> IO a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ModEnv -> IO a
f)
withDepEnv :: Env -> (DepEnv -> IO a) -> IO a
withDepEnv  (MVar ()
mvar,IORef ModEnv
_,IORef DepEnv
ref,IORef PkgEnvs
_,IORef (Set [Char])
_,IORef MergeEnv
_) DepEnv -> IO a
f = MVar () -> (() -> IO a) -> IO a
forall a b. MVar a -> (a -> IO b) -> IO b
withMVar MVar ()
mvar (\()
_ -> IORef DepEnv -> IO DepEnv
forall a. IORef a -> IO a
readIORef IORef DepEnv
ref IO DepEnv -> (DepEnv -> IO a) -> IO a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= DepEnv -> IO a
f)
withPkgEnvs :: Env -> (PkgEnvs -> IO a) -> IO a
withPkgEnvs (MVar ()
mvar,IORef ModEnv
_,IORef DepEnv
_,IORef PkgEnvs
ref,IORef (Set [Char])
_,IORef MergeEnv
_) PkgEnvs -> IO a
f = MVar () -> (() -> IO a) -> IO a
forall a b. MVar a -> (a -> IO b) -> IO b
withMVar MVar ()
mvar (\()
_ -> IORef PkgEnvs -> IO PkgEnvs
forall a. IORef a -> IO a
readIORef IORef PkgEnvs
ref IO PkgEnvs -> (PkgEnvs -> IO a) -> IO a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= PkgEnvs -> IO a
f)
withStaticPkgEnv :: Env -> (Set [Char] -> IO a) -> IO a
withStaticPkgEnv (MVar ()
mvar,IORef ModEnv
_,IORef DepEnv
_,IORef PkgEnvs
_,IORef (Set [Char])
ref,IORef MergeEnv
_) Set [Char] -> IO a
f = MVar () -> (() -> IO a) -> IO a
forall a b. MVar a -> (a -> IO b) -> IO b
withMVar MVar ()
mvar (\()
_ -> IORef (Set [Char]) -> IO (Set [Char])
forall a. IORef a -> IO a
readIORef IORef (Set [Char])
ref IO (Set [Char]) -> (Set [Char] -> IO a) -> IO a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Set [Char] -> IO a
f)
withMerged :: Env -> (MergeEnv -> IO a) -> IO a
withMerged  (MVar ()
mvar,IORef ModEnv
_,IORef DepEnv
_,IORef PkgEnvs
_,IORef (Set [Char])
_,IORef MergeEnv
ref) MergeEnv -> IO a
f = MVar () -> (() -> IO a) -> IO a
forall a b. MVar a -> (a -> IO b) -> IO b
withMVar MVar ()
mvar (\()
_ -> IORef MergeEnv -> IO MergeEnv
forall a. IORef a -> IO a
readIORef IORef MergeEnv
ref IO MergeEnv -> (MergeEnv -> IO a) -> IO a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= MergeEnv -> IO a
f)

-- -----------------------------------------------------------
--
-- write an object name
-- write a new PackageConfig
--
modifyModEnv :: Env -> (ModEnv   -> IO ModEnv)  -> IO ()
modifyDepEnv :: Env -> (DepEnv   -> IO DepEnv)  -> IO ()
modifyPkgEnv :: Env -> (PkgEnvs  -> IO PkgEnvs) -> IO ()
modifyStaticPkgEnv :: Env -> (StaticPkgEnv  -> IO StaticPkgEnv) -> IO ()
modifyMerged :: Env -> (MergeEnv -> IO MergeEnv)-> IO ()

modifyModEnv :: Env -> (ModEnv -> IO ModEnv) -> IO ()
modifyModEnv (MVar ()
mvar,IORef ModEnv
ref,IORef DepEnv
_,IORef PkgEnvs
_,IORef (Set [Char])
_,IORef MergeEnv
_) ModEnv -> IO ModEnv
f = MVar () -> IORef ModEnv -> (ModEnv -> IO ModEnv) -> IO ()
forall a a. MVar a -> IORef a -> (a -> IO a) -> IO ()
lockAndWrite MVar ()
mvar IORef ModEnv
ref ModEnv -> IO ModEnv
f
modifyDepEnv :: Env -> (DepEnv -> IO DepEnv) -> IO ()
modifyDepEnv (MVar ()
mvar,IORef ModEnv
_,IORef DepEnv
ref,IORef PkgEnvs
_,IORef (Set [Char])
_,IORef MergeEnv
_) DepEnv -> IO DepEnv
f = MVar () -> IORef DepEnv -> (DepEnv -> IO DepEnv) -> IO ()
forall a a. MVar a -> IORef a -> (a -> IO a) -> IO ()
lockAndWrite MVar ()
mvar IORef DepEnv
ref DepEnv -> IO DepEnv
f
modifyPkgEnv :: Env -> (PkgEnvs -> IO PkgEnvs) -> IO ()
modifyPkgEnv (MVar ()
mvar,IORef ModEnv
_,IORef DepEnv
_,IORef PkgEnvs
ref,IORef (Set [Char])
_,IORef MergeEnv
_) PkgEnvs -> IO PkgEnvs
f = MVar () -> IORef PkgEnvs -> (PkgEnvs -> IO PkgEnvs) -> IO ()
forall a a. MVar a -> IORef a -> (a -> IO a) -> IO ()
lockAndWrite MVar ()
mvar IORef PkgEnvs
ref PkgEnvs -> IO PkgEnvs
f
modifyStaticPkgEnv :: Env -> (Set [Char] -> IO (Set [Char])) -> IO ()
modifyStaticPkgEnv (MVar ()
mvar,IORef ModEnv
_,IORef DepEnv
_,IORef PkgEnvs
_,IORef (Set [Char])
ref,IORef MergeEnv
_) Set [Char] -> IO (Set [Char])
f = MVar ()
-> IORef (Set [Char]) -> (Set [Char] -> IO (Set [Char])) -> IO ()
forall a a. MVar a -> IORef a -> (a -> IO a) -> IO ()
lockAndWrite MVar ()
mvar IORef (Set [Char])
ref Set [Char] -> IO (Set [Char])
f
modifyMerged :: Env -> (MergeEnv -> IO MergeEnv) -> IO ()
modifyMerged (MVar ()
mvar,IORef ModEnv
_,IORef DepEnv
_,IORef PkgEnvs
_,IORef (Set [Char])
_,IORef MergeEnv
ref) MergeEnv -> IO MergeEnv
f = MVar () -> IORef MergeEnv -> (MergeEnv -> IO MergeEnv) -> IO ()
forall a a. MVar a -> IORef a -> (a -> IO a) -> IO ()
lockAndWrite MVar ()
mvar IORef MergeEnv
ref MergeEnv -> IO MergeEnv
f

-- private
lockAndWrite :: MVar a -> IORef a -> (a -> IO a) -> IO ()
lockAndWrite MVar a
mvar IORef a
ref a -> IO a
f = MVar a -> (a -> IO ()) -> IO ()
forall a b. MVar a -> (a -> IO b) -> IO b
withMVar MVar a
mvar (\a
_->IORef a -> IO a
forall a. IORef a -> IO a
readIORef IORef a
refIO a -> (a -> IO a) -> IO a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=a -> IO a
fIO a -> (a -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=IORef a -> a -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef a
ref)

-- -----------------------------------------------------------
--
-- | insert a loaded module name into the environment
--
addModule :: String -> Module -> IO ()
addModule :: [Char] -> Module -> IO ()
addModule [Char]
s Module
m = Env -> (ModEnv -> IO ModEnv) -> IO ()
modifyModEnv Env
forall key elt key elt key elt.
(MVar (), IORef (FiniteMap key elt), IORef (FiniteMap key elt),
 IORef PkgEnvs, IORef (Set [Char]), IORef (FiniteMap key elt))
env ((ModEnv -> IO ModEnv) -> IO ()) -> (ModEnv -> IO ModEnv) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ModEnv
fm -> let c :: Int
c = Int -> ((Module, Int) -> Int) -> Maybe (Module, Int) -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 (Module, Int) -> Int
forall a b. (a, b) -> b
snd (ModEnv -> [Char] -> Maybe (Module, Int)
forall key elt. Ord key => FiniteMap key elt -> key -> Maybe elt
lookupFM ModEnv
fm [Char]
s)
                                          in ModEnv -> IO ModEnv
forall (m :: * -> *) a. Monad m => a -> m a
return (ModEnv -> IO ModEnv) -> ModEnv -> IO ModEnv
forall a b. (a -> b) -> a -> b
$ ModEnv -> [Char] -> (Module, Int) -> ModEnv
forall key elt.
Ord key =>
FiniteMap key elt -> key -> elt -> FiniteMap key elt
addToFM ModEnv
fm [Char]
s (Module
m,Int
cInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)

--getModule :: String -> IO (Maybe Module)
--getModule s = withModEnv env $ \fm -> return (lookupFM fm s)

--
-- | remove a module name from the environment. Returns True if the
-- module was actually removed.
--
rmModule :: String -> IO Bool
rmModule :: [Char] -> IO Bool
rmModule [Char]
s = do Env -> (ModEnv -> IO ModEnv) -> IO ()
modifyModEnv Env
forall key elt key elt key elt.
(MVar (), IORef (FiniteMap key elt), IORef (FiniteMap key elt),
 IORef PkgEnvs, IORef (Set [Char]), IORef (FiniteMap key elt))
env ((ModEnv -> IO ModEnv) -> IO ()) -> (ModEnv -> IO ModEnv) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ModEnv
fm -> let c :: Int
c = Int -> ((Module, Int) -> Int) -> Maybe (Module, Int) -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
1 (Module, Int) -> Int
forall a b. (a, b) -> b
snd (ModEnv -> [Char] -> Maybe (Module, Int)
forall key elt. Ord key => FiniteMap key elt -> key -> Maybe elt
lookupFM ModEnv
fm [Char]
s)
                                              fm' :: ModEnv
fm' = ModEnv -> [Char] -> ModEnv
forall key elt.
Ord key =>
FiniteMap key elt -> key -> FiniteMap key elt
delFromFM ModEnv
fm [Char]
s
                                          in if Int
cInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0
                                                then ModEnv -> IO ModEnv
forall (m :: * -> *) a. Monad m => a -> m a
return ModEnv
fm'
                                                else ModEnv -> IO ModEnv
forall (m :: * -> *) a. Monad m => a -> m a
return ModEnv
fm
                Env -> (ModEnv -> IO Bool) -> IO Bool
forall a. Env -> (ModEnv -> IO a) -> IO a
withModEnv Env
forall key elt key elt key elt.
(MVar (), IORef (FiniteMap key elt), IORef (FiniteMap key elt),
 IORef PkgEnvs, IORef (Set [Char]), IORef (FiniteMap key elt))
env ((ModEnv -> IO Bool) -> IO Bool) -> (ModEnv -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \ModEnv
fm -> Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Module, Int) -> Bool
forall a. Maybe a -> Bool
isNothing  (ModEnv -> [Char] -> Maybe (Module, Int)
forall key elt. Ord key => FiniteMap key elt -> key -> Maybe elt
lookupFM ModEnv
fm [Char]
s))

--
-- | insert a list of module names all in one go
--
addModules :: [(String,Module)] -> IO ()
addModules :: [([Char], Module)] -> IO ()
addModules [([Char], Module)]
ns = (([Char], Module) -> IO ()) -> [([Char], Module)] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (([Char] -> Module -> IO ()) -> ([Char], Module) -> IO ()
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry [Char] -> Module -> IO ()
addModule) [([Char], Module)]
ns

--
-- | is a module\/package already loaded?
--
isLoaded :: String -> IO Bool
isLoaded :: [Char] -> IO Bool
isLoaded [Char]
s = Env -> (ModEnv -> IO Bool) -> IO Bool
forall a. Env -> (ModEnv -> IO a) -> IO a
withModEnv Env
forall key elt key elt key elt.
(MVar (), IORef (FiniteMap key elt), IORef (FiniteMap key elt),
 IORef PkgEnvs, IORef (Set [Char]), IORef (FiniteMap key elt))
env ((ModEnv -> IO Bool) -> IO Bool) -> (ModEnv -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \ModEnv
fm -> Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> IO Bool) -> Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ Maybe (Module, Int) -> Bool
forall a. Maybe a -> Bool
isJust (ModEnv -> [Char] -> Maybe (Module, Int)
forall key elt. Ord key => FiniteMap key elt -> key -> Maybe elt
lookupFM ModEnv
fm [Char]
s)

--
-- confusing! only for filter.
--
loaded :: String -> IO Bool
loaded :: [Char] -> IO Bool
loaded [Char]
m = do Bool
t <- [Char] -> IO Bool
isLoaded [Char]
m ; Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> Bool
not Bool
t)

-- -----------------------------------------------------------
--
-- module dependency stuff
--

--
-- | Set the dependencies of a Module.
--
addModuleDeps :: Module -> [Module] -> IO ()
addModuleDeps :: Module -> [Module] -> IO ()
addModuleDeps Module
m [Module]
deps = Env -> (DepEnv -> IO DepEnv) -> IO ()
modifyDepEnv Env
forall key elt key elt key elt.
(MVar (), IORef (FiniteMap key elt), IORef (FiniteMap key elt),
 IORef PkgEnvs, IORef (Set [Char]), IORef (FiniteMap key elt))
env ((DepEnv -> IO DepEnv) -> IO ()) -> (DepEnv -> IO DepEnv) -> IO ()
forall a b. (a -> b) -> a -> b
$ \DepEnv
fm -> DepEnv -> IO DepEnv
forall (m :: * -> *) a. Monad m => a -> m a
return (DepEnv -> IO DepEnv) -> DepEnv -> IO DepEnv
forall a b. (a -> b) -> a -> b
$ DepEnv -> Module -> [Module] -> DepEnv
forall key elt.
Ord key =>
FiniteMap key elt -> key -> elt -> FiniteMap key elt
addToFM DepEnv
fm Module
m [Module]
deps

--
-- | Get module dependencies. Nothing if none have been recored.
--
getModuleDeps :: Module -> IO [Module]
getModuleDeps :: Module -> IO [Module]
getModuleDeps Module
m = Env -> (DepEnv -> IO [Module]) -> IO [Module]
forall a. Env -> (DepEnv -> IO a) -> IO a
withDepEnv Env
forall key elt key elt key elt.
(MVar (), IORef (FiniteMap key elt), IORef (FiniteMap key elt),
 IORef PkgEnvs, IORef (Set [Char]), IORef (FiniteMap key elt))
env ((DepEnv -> IO [Module]) -> IO [Module])
-> (DepEnv -> IO [Module]) -> IO [Module]
forall a b. (a -> b) -> a -> b
$ \DepEnv
fm -> [Module] -> IO [Module]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Module] -> IO [Module]) -> [Module] -> IO [Module]
forall a b. (a -> b) -> a -> b
$ [Module] -> Maybe [Module] -> [Module]
forall a. a -> Maybe a -> a
fromMaybe [] (DepEnv -> Module -> Maybe [Module]
forall key elt. Ord key => FiniteMap key elt -> key -> Maybe elt
lookupFM DepEnv
fm Module
m)


--
-- | Unrecord a module from the environment.
--
rmModuleDeps :: Module -> IO ()
rmModuleDeps :: Module -> IO ()
rmModuleDeps Module
m = Env -> (DepEnv -> IO DepEnv) -> IO ()
modifyDepEnv Env
forall key elt key elt key elt.
(MVar (), IORef (FiniteMap key elt), IORef (FiniteMap key elt),
 IORef PkgEnvs, IORef (Set [Char]), IORef (FiniteMap key elt))
env ((DepEnv -> IO DepEnv) -> IO ()) -> (DepEnv -> IO DepEnv) -> IO ()
forall a b. (a -> b) -> a -> b
$ \DepEnv
fm -> DepEnv -> IO DepEnv
forall (m :: * -> *) a. Monad m => a -> m a
return (DepEnv -> IO DepEnv) -> DepEnv -> IO DepEnv
forall a b. (a -> b) -> a -> b
$ DepEnv -> Module -> DepEnv
forall key elt.
Ord key =>
FiniteMap key elt -> key -> FiniteMap key elt
delFromFM DepEnv
fm Module
m

-- -----------------------------------------------------------
-- Package management stuff

--
-- | Insert a single package.conf (containing multiple configs) means:
-- create a new FM. insert packages into FM. add FM to end of list of FM
-- stored in the environment.
--
addPkgConf :: FilePath -> IO ()
addPkgConf :: [Char] -> IO ()
addPkgConf [Char]
f = do
    [PackageConfig]
ps <- [Char] -> IO [PackageConfig]
readPackageConf [Char]
f
    Env -> (PkgEnvs -> IO PkgEnvs) -> IO ()
modifyPkgEnv Env
forall key elt key elt key elt.
(MVar (), IORef (FiniteMap key elt), IORef (FiniteMap key elt),
 IORef PkgEnvs, IORef (Set [Char]), IORef (FiniteMap key elt))
env ((PkgEnvs -> IO PkgEnvs) -> IO ())
-> (PkgEnvs -> IO PkgEnvs) -> IO ()
forall a b. (a -> b) -> a -> b
$ \PkgEnvs
ls -> PkgEnvs -> IO PkgEnvs
forall (m :: * -> *) a. Monad m => a -> m a
return (PkgEnvs -> IO PkgEnvs) -> PkgEnvs -> IO PkgEnvs
forall a b. (a -> b) -> a -> b
$ PkgEnvs -> [PackageConfig] -> PkgEnvs
union PkgEnvs
ls [PackageConfig]
ps

-- | This function is required when running with stack.
defaultPkgConf :: IO ()
defaultPkgConf :: IO ()
defaultPkgConf = do
  Maybe [Char]
paths <- [Char] -> IO (Maybe [Char])
lookupEnv [Char]
"GHC_PACKAGE_PATH"
  [Char] -> IO ()
unsetEnv [Char]
"GHC_PACKAGE_PATH"
  case Maybe [Char]
paths of
    Maybe [Char]
Nothing -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    Just [Char]
s -> ([Char] -> IO ()) -> [[Char]] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ [Char] -> IO ()
addPkgConf ([[Char]] -> IO ()) -> [[Char]] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char] -> [[Char]]
forall a. Eq a => [a] -> [a] -> [[a]]
splitOn [Char]
":" [Char]
s

--
-- | add a new FM for the package.conf to the list of existing ones; if a package occurs multiple
-- times, pick the one with the higher version number as the default (e.g., important for base in
-- GHC 6.12)
--
union :: PkgEnvs -> [PackageConfig] -> PkgEnvs
union :: PkgEnvs -> [PackageConfig] -> PkgEnvs
union PkgEnvs
ls [PackageConfig]
ps' =
        let fm :: FiniteMap key elt
fm = FiniteMap key elt
forall k a. Map k a
emptyFM -- new FM for this package.conf
        in (PackageConfig
 -> FiniteMap [Char] PackageConfig
 -> FiniteMap [Char] PackageConfig)
-> FiniteMap [Char] PackageConfig
-> [PackageConfig]
-> FiniteMap [Char] PackageConfig
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr PackageConfig
-> FiniteMap [Char] PackageConfig -> FiniteMap [Char] PackageConfig
addOnePkg FiniteMap [Char] PackageConfig
forall k a. Map k a
fm [PackageConfig]
ps' FiniteMap [Char] PackageConfig -> PkgEnvs -> PkgEnvs
forall a. a -> [a] -> [a]
: PkgEnvs
ls
    where
      -- we add each package with and without it's version number and with the full installedPackageId
      addOnePkg :: PackageConfig
-> FiniteMap [Char] PackageConfig -> FiniteMap [Char] PackageConfig
addOnePkg PackageConfig
p FiniteMap [Char] PackageConfig
fm' = FiniteMap [Char] PackageConfig
-> [Char] -> PackageConfig -> FiniteMap [Char] PackageConfig
addToPkgEnvs (FiniteMap [Char] PackageConfig
-> [Char] -> PackageConfig -> FiniteMap [Char] PackageConfig
addToPkgEnvs (FiniteMap [Char] PackageConfig
-> [Char] -> PackageConfig -> FiniteMap [Char] PackageConfig
addToPkgEnvs FiniteMap [Char] PackageConfig
fm' (PackageId -> [Char]
forall a. Pretty a => a -> [Char]
display (PackageId -> [Char]) -> PackageId -> [Char]
forall a b. (a -> b) -> a -> b
$ PackageConfig -> PackageId
sourcePackageId PackageConfig
p) PackageConfig
p) (PackageId -> [Char]
forall a. Pretty a => a -> [Char]
display (PackageId -> [Char]) -> PackageId -> [Char]
forall a b. (a -> b) -> a -> b
$ PackageConfig -> PackageId
forall pkg. Package pkg => pkg -> PackageId
packageId PackageConfig
p) PackageConfig
p)
                                     (PackageConfig -> [Char]
packageName PackageConfig
p) PackageConfig
p

      -- if no version number specified, pick the higher version
      addToPkgEnvs :: FiniteMap [Char] PackageConfig
-> [Char] -> PackageConfig -> FiniteMap [Char] PackageConfig
addToPkgEnvs = (PackageConfig -> PackageConfig -> PackageConfig)
-> FiniteMap [Char] PackageConfig
-> [Char]
-> PackageConfig
-> FiniteMap [Char] PackageConfig
forall key elt.
Ord key =>
(elt -> elt -> elt)
-> FiniteMap key elt -> key -> elt -> FiniteMap key elt
addWithFM PackageConfig -> PackageConfig -> PackageConfig
forall p. Package p => p -> p -> p
higherVersion

      higherVersion :: p -> p -> p
higherVersion p
pkgconf1 p
pkgconf2
        | p -> PackageId
forall pkg. Package pkg => pkg -> PackageId
packageId p
pkgconf1 PackageId -> PackageId -> Bool
forall a. Ord a => a -> a -> Bool
>= p -> PackageId
forall pkg. Package pkg => pkg -> PackageId
packageId p
pkgconf2 = p
pkgconf1
        | Bool
otherwise                                                  = p
pkgconf2

--
-- | generate a PkgEnv from the system package.conf
-- The path to the default package.conf was determined by /configure/
-- This imposes a constraint that you must build your plugins with the
-- same ghc you use to build hs-plugins. This is reasonable, we feel.
--

grabDefaultPkgConf :: IO PkgEnvs
grabDefaultPkgConf :: IO PkgEnvs
grabDefaultPkgConf = do
        ProgramDb
pc <- Verbosity -> ProgramDb -> IO ProgramDb
configureAllKnownPrograms Verbosity
silent ProgramDb
defaultProgramDb
#if MIN_VERSION_Cabal(1,24,0)
        (Compiler
compiler, Maybe Platform
_platform, ProgramDb
_programConfiguration)
           <- Verbosity
-> Maybe [Char]
-> Maybe [Char]
-> ProgramDb
-> IO (Compiler, Maybe Platform, ProgramDb)
configure Verbosity
silent Maybe [Char]
forall a. Maybe a
Nothing Maybe [Char]
forall a. Maybe a
Nothing ProgramDb
pc
        InstalledPackageIndex
pkgIndex <- Verbosity
-> Compiler
-> PackageDBStack
-> ProgramDb
-> IO InstalledPackageIndex
getInstalledPackages Verbosity
silent Compiler
compiler
                        [PackageDB
GlobalPackageDB, PackageDB
UserPackageDB] ProgramDb
pc
#else
        pkgIndex <- getInstalledPackages silent [GlobalPackageDB, UserPackageDB] pc
#endif
        PkgEnvs -> IO PkgEnvs
forall (m :: * -> *) a. Monad m => a -> m a
return (PkgEnvs -> IO PkgEnvs) -> PkgEnvs -> IO PkgEnvs
forall a b. (a -> b) -> a -> b
$ [] PkgEnvs -> [PackageConfig] -> PkgEnvs
`union` InstalledPackageIndex -> [PackageConfig]
forall a. PackageIndex a -> [a]
allPackages InstalledPackageIndex
pkgIndex

--
-- parse a source file, expanding any $libdir we see.
--
readPackageConf :: FilePath -> IO [PackageConfig]
readPackageConf :: [Char] -> IO [PackageConfig]
readPackageConf [Char]
f = do
    ProgramDb
pc <- Verbosity -> ProgramDb -> IO ProgramDb
configureAllKnownPrograms Verbosity
silent ProgramDb
defaultProgramDb
#if MIN_VERSION_Cabal(1,24,0)
    (Compiler
compiler, Maybe Platform
_platform, ProgramDb
_programConfiguration)
       <- Verbosity
-> Maybe [Char]
-> Maybe [Char]
-> ProgramDb
-> IO (Compiler, Maybe Platform, ProgramDb)
configure Verbosity
silent Maybe [Char]
forall a. Maybe a
Nothing Maybe [Char]
forall a. Maybe a
Nothing ProgramDb
pc
    InstalledPackageIndex
pkgIndex <- Verbosity
-> Compiler
-> PackageDBStack
-> ProgramDb
-> IO InstalledPackageIndex
getInstalledPackages Verbosity
silent Compiler
compiler [PackageDB
GlobalPackageDB, PackageDB
UserPackageDB, [Char] -> PackageDB
SpecificPackageDB [Char]
f] ProgramDb
pc
#else
    pkgIndex <- getInstalledPackages silent [GlobalPackageDB, UserPackageDB, SpecificPackageDB f] pc
#endif
    [PackageConfig] -> IO [PackageConfig]
forall (m :: * -> *) a. Monad m => a -> m a
return ([PackageConfig] -> IO [PackageConfig])
-> [PackageConfig] -> IO [PackageConfig]
forall a b. (a -> b) -> a -> b
$ InstalledPackageIndex -> [PackageConfig]
forall a. PackageIndex a -> [a]
allPackages InstalledPackageIndex
pkgIndex

-- -----------------------------------------------------------
-- Static package management stuff. A static package is linked with the base
-- application and we should therefore not link with any of the DLLs it requires.

addStaticPkg :: PackageName -> IO ()
addStaticPkg :: [Char] -> IO ()
addStaticPkg [Char]
pkg = Env -> (Set [Char] -> IO (Set [Char])) -> IO ()
modifyStaticPkgEnv Env
forall key elt key elt key elt.
(MVar (), IORef (FiniteMap key elt), IORef (FiniteMap key elt),
 IORef PkgEnvs, IORef (Set [Char]), IORef (FiniteMap key elt))
env ((Set [Char] -> IO (Set [Char])) -> IO ())
-> (Set [Char] -> IO (Set [Char])) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Set [Char]
set -> Set [Char] -> IO (Set [Char])
forall (m :: * -> *) a. Monad m => a -> m a
return (Set [Char] -> IO (Set [Char])) -> Set [Char] -> IO (Set [Char])
forall a b. (a -> b) -> a -> b
$ [Char] -> Set [Char] -> Set [Char]
forall a. Ord a => a -> Set a -> Set a
S.insert [Char]
pkg Set [Char]
set

isStaticPkg :: PackageName -> IO Bool
isStaticPkg :: [Char] -> IO Bool
isStaticPkg [Char]
pkg = Env -> (Set [Char] -> IO Bool) -> IO Bool
forall a. Env -> (Set [Char] -> IO a) -> IO a
withStaticPkgEnv Env
forall key elt key elt key elt.
(MVar (), IORef (FiniteMap key elt), IORef (FiniteMap key elt),
 IORef PkgEnvs, IORef (Set [Char]), IORef (FiniteMap key elt))
env ((Set [Char] -> IO Bool) -> IO Bool)
-> (Set [Char] -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \Set [Char]
set -> Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> IO Bool) -> Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ [Char] -> Set [Char] -> Bool
forall a. Ord a => a -> Set a -> Bool
S.member [Char]
pkg Set [Char]
set

rmStaticPkg :: String -> IO Bool
rmStaticPkg :: [Char] -> IO Bool
rmStaticPkg [Char]
pkg = do
  (Bool
willRemove, Set [Char]
s) <- Env
-> (Set [Char] -> IO (Bool, Set [Char])) -> IO (Bool, Set [Char])
forall a. Env -> (Set [Char] -> IO a) -> IO a
withStaticPkgEnv Env
forall key elt key elt key elt.
(MVar (), IORef (FiniteMap key elt), IORef (FiniteMap key elt),
 IORef PkgEnvs, IORef (Set [Char]), IORef (FiniteMap key elt))
env ((Set [Char] -> IO (Bool, Set [Char])) -> IO (Bool, Set [Char]))
-> (Set [Char] -> IO (Bool, Set [Char])) -> IO (Bool, Set [Char])
forall a b. (a -> b) -> a -> b
$ \Set [Char]
s -> (Bool, Set [Char]) -> IO (Bool, Set [Char])
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> Set [Char] -> Bool
forall a. Ord a => a -> Set a -> Bool
S.member [Char]
pkg Set [Char]
s, Set [Char]
s)
  if Bool -> Bool
not Bool
willRemove then Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
    else do Env -> (Set [Char] -> IO (Set [Char])) -> IO ()
modifyStaticPkgEnv Env
forall key elt key elt key elt.
(MVar (), IORef (FiniteMap key elt), IORef (FiniteMap key elt),
 IORef PkgEnvs, IORef (Set [Char]), IORef (FiniteMap key elt))
env ((Set [Char] -> IO (Set [Char])) -> IO ())
-> (Set [Char] -> IO (Set [Char])) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Set [Char]
s' -> Set [Char] -> IO (Set [Char])
forall (m :: * -> *) a. Monad m => a -> m a
return (Set [Char] -> IO (Set [Char])) -> Set [Char] -> IO (Set [Char])
forall a b. (a -> b) -> a -> b
$ [Char] -> Set [Char] -> Set [Char]
forall a. Ord a => a -> Set a -> Set a
S.delete [Char]
pkg Set [Char]
s'
            Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
--
-- Package path, given a package name, look it up in the environment and
-- return the path to all the libraries needed to load this package.
--
-- What do we need to load? With the library_dirs as prefix paths:
--      . anything in the hs_libraries fields, libdir expanded
--
--      . anything in the extra_libraries fields (i.e. cbits), expanded,
--
--      which includes system .so files.
--
--      . also load any dependencies now, because of that weird mtl
--      library that lang depends upon, but which doesn't show up in the
--      interfaces for some reason.
--
-- We return all the package paths that possibly exist, and the leave it
-- up to loadObject not to load the same ones twice...
--
lookupPkg :: PackageName -> IO ([FilePath],[FilePath])
lookupPkg :: [Char] -> IO ([[Char]], [[Char]])
lookupPkg [Char]
pn = [[Char]] -> [Char] -> IO ([[Char]], [[Char]])
go [] [Char]
pn
    where
      go :: [PackageName] -> PackageName -> IO ([FilePath],[FilePath])
      go :: [[Char]] -> [Char] -> IO ([[Char]], [[Char]])
go [[Char]]
seen [Char]
p = do
        ([[Char]]
ps, ([[Char]]
f, [[Char]]
g)) <- [Char] -> IO ([[Char]], ([[Char]], [[Char]]))
lookupPkg' [Char]
p
        Bool
static <- if Bool -> Bool
not ([[Char]] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Char]]
f) Bool -> Bool -> Bool
&& [[Char]] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Char]]
g
                  then [Char] -> IO ()
addStaticPkg [Char]
p IO () -> IO Bool -> IO Bool
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
                  else [Char] -> IO Bool
isStaticPkg [Char]
p
        ([[[Char]]]
f', [[[Char]]]
g') <- ([([[Char]], [[Char]])] -> ([[[Char]]], [[[Char]]]))
-> IO [([[Char]], [[Char]])] -> IO ([[[Char]]], [[[Char]]])
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM [([[Char]], [[Char]])] -> ([[[Char]]], [[[Char]]])
forall a b. [(a, b)] -> ([a], [b])
unzip (IO [([[Char]], [[Char]])] -> IO ([[[Char]]], [[[Char]]]))
-> IO [([[Char]], [[Char]])] -> IO ([[[Char]]], [[[Char]]])
forall a b. (a -> b) -> a -> b
$ ([Char] -> IO ([[Char]], [[Char]]))
-> [[Char]] -> IO [([[Char]], [[Char]])]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ([[Char]] -> [Char] -> IO ([[Char]], [[Char]])
go ([[Char]] -> [[Char]]
forall a. Eq a => [a] -> [a]
nub ([[Char]] -> [[Char]]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> a -> b
$ [[Char]]
seen [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [[Char]]
ps)) ([[Char]]
ps [[Char]] -> [[Char]] -> [[Char]]
forall a. Eq a => [a] -> [a] -> [a]
\\ [[Char]]
seen)
        ([[Char]], [[Char]]) -> IO ([[Char]], [[Char]])
forall (m :: * -> *) a. Monad m => a -> m a
return (([[Char]], [[Char]]) -> IO ([[Char]], [[Char]]))
-> ([[Char]], [[Char]]) -> IO ([[Char]], [[Char]])
forall a b. (a -> b) -> a -> b
$ ([[Char]] -> [[Char]]
forall a. Eq a => [a] -> [a]
nub ([[Char]] -> [[Char]]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> a -> b
$ ([[[Char]]] -> [[Char]]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[[Char]]]
f') [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [[Char]]
f, if Bool
static then [] else [[Char]] -> [[Char]]
forall a. Eq a => [a] -> [a]
nub ([[Char]] -> [[Char]]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> a -> b
$ ([[[Char]]] -> [[Char]]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[[Char]]]
g') [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [[Char]]
g)

-- This is the prefix of mangled symbols that come from this package.
pkgManglingPrefix :: PackageName -> IO (Maybe String)
-- base seems to be mangled differently!
pkgManglingPrefix :: [Char] -> IO (Maybe [Char])
pkgManglingPrefix [Char]
"base" = Maybe [Char] -> IO (Maybe [Char])
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe [Char] -> IO (Maybe [Char]))
-> Maybe [Char] -> IO (Maybe [Char])
forall a b. (a -> b) -> a -> b
$ [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
"base"
pkgManglingPrefix [Char]
p = Env -> (PkgEnvs -> IO (Maybe [Char])) -> IO (Maybe [Char])
forall a. Env -> (PkgEnvs -> IO a) -> IO a
withPkgEnvs Env
forall key elt key elt key elt.
(MVar (), IORef (FiniteMap key elt), IORef (FiniteMap key elt),
 IORef PkgEnvs, IORef (Set [Char]), IORef (FiniteMap key elt))
env ((PkgEnvs -> IO (Maybe [Char])) -> IO (Maybe [Char]))
-> (PkgEnvs -> IO (Maybe [Char])) -> IO (Maybe [Char])
forall a b. (a -> b) -> a -> b
$ \PkgEnvs
fms -> Maybe [Char] -> IO (Maybe [Char])
forall (m :: * -> *) a. Monad m => a -> m a
return (PkgEnvs -> [Char] -> Maybe [Char]
forall t. Ord t => [FiniteMap t PackageConfig] -> t -> Maybe [Char]
go PkgEnvs
fms [Char]
p)
    where
        go :: [FiniteMap t PackageConfig] -> t -> Maybe [Char]
go [] t
_       = Maybe [Char]
forall a. Maybe a
Nothing
        go (FiniteMap t PackageConfig
fm:[FiniteMap t PackageConfig]
fms) t
q = case FiniteMap t PackageConfig -> t -> Maybe PackageConfig
forall key elt. Ord key => FiniteMap key elt -> key -> Maybe elt
lookupFM FiniteMap t PackageConfig
fm t
q of
            Maybe PackageConfig
Nothing -> [FiniteMap t PackageConfig] -> t -> Maybe [Char]
go [FiniteMap t PackageConfig]
fms t
q     -- look in other pkgs
            Just PackageConfig
pkg -> [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just ([Char] -> Maybe [Char]) -> [Char] -> Maybe [Char]
forall a b. (a -> b) -> a -> b
$ Int -> [Char] -> [Char]
forall a. Int -> [a] -> [a]
drop Int
2 ([Char] -> [Char]) -> [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$ UnitId -> [Char]
getHSLibraryName (UnitId -> [Char]) -> UnitId -> [Char]
forall a b. (a -> b) -> a -> b
$ PackageConfig -> UnitId
installedUnitId PackageConfig
pkg

data LibrarySpec
   = DLL String         -- -lLib
   | DLLPath FilePath   -- -Lpath

classifyLdInput :: FilePath -> IO (Maybe LibrarySpec)
classifyLdInput :: [Char] -> IO (Maybe LibrarySpec)
classifyLdInput (Char
'-':Char
'l':[Char]
lib) = Maybe LibrarySpec -> IO (Maybe LibrarySpec)
forall (m :: * -> *) a. Monad m => a -> m a
return (LibrarySpec -> Maybe LibrarySpec
forall a. a -> Maybe a
Just ([Char] -> LibrarySpec
DLL [Char]
lib))
classifyLdInput (Char
'-':Char
'L':[Char]
path) = Maybe LibrarySpec -> IO (Maybe LibrarySpec)
forall (m :: * -> *) a. Monad m => a -> m a
return (LibrarySpec -> Maybe LibrarySpec
forall a. a -> Maybe a
Just ([Char] -> LibrarySpec
DLLPath [Char]
path))
classifyLdInput [Char]
_ = Maybe LibrarySpec -> IO (Maybe LibrarySpec)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe LibrarySpec
forall a. Maybe a
Nothing

-- TODO need to define a MAC\/DARWIN symbol
#if defined(MACOSX)
mkSOName root = "lib" ++ root ++ ".dylib"
#elif defined(CYGWIN) || defined(__MINGW32__)
-- Win32 DLLs have no .dll extension here, because addDLL tries
-- both foo.dll and foo.drv
mkSOName root = root
#else
mkSOName :: [Char] -> [Char]
mkSOName [Char]
root = [Char]
"lib" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
root [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
".so"
#endif

#if defined(MACOSX)
mkDynPkgName root = mkSOName (root ++ "_dyn")
#else
mkDynPkgName :: [Char] -> [Char]
mkDynPkgName [Char]
root = [Char] -> [Char]
mkSOName [Char]
root
#endif

data HSLib = Static FilePath | Dynamic FilePath

--
-- return any stuff to load for this package, plus the list of packages
-- this package depends on. which includes stuff we have to then load
-- too.
--
lookupPkg' :: PackageName -> IO ([PackageName],([FilePath],[FilePath]))
lookupPkg' :: [Char] -> IO ([[Char]], ([[Char]], [[Char]]))
lookupPkg' [Char]
p = Env
-> (PkgEnvs -> IO ([[Char]], ([[Char]], [[Char]])))
-> IO ([[Char]], ([[Char]], [[Char]]))
forall a. Env -> (PkgEnvs -> IO a) -> IO a
withPkgEnvs Env
forall key elt key elt key elt.
(MVar (), IORef (FiniteMap key elt), IORef (FiniteMap key elt),
 IORef PkgEnvs, IORef (Set [Char]), IORef (FiniteMap key elt))
env ((PkgEnvs -> IO ([[Char]], ([[Char]], [[Char]])))
 -> IO ([[Char]], ([[Char]], [[Char]])))
-> (PkgEnvs -> IO ([[Char]], ([[Char]], [[Char]])))
-> IO ([[Char]], ([[Char]], [[Char]]))
forall a b. (a -> b) -> a -> b
$ \PkgEnvs
fms -> PkgEnvs -> [Char] -> IO ([[Char]], ([[Char]], [[Char]]))
forall t.
Ord t =>
[FiniteMap t PackageConfig]
-> t -> IO ([[Char]], ([[Char]], [[Char]]))
go PkgEnvs
fms [Char]
p
    where
        go :: [FiniteMap t PackageConfig]
-> t -> IO ([[Char]], ([[Char]], [[Char]]))
go [] t
_       = ([[Char]], ([[Char]], [[Char]]))
-> IO ([[Char]], ([[Char]], [[Char]]))
forall (m :: * -> *) a. Monad m => a -> m a
return ([],([],[]))
        go (FiniteMap t PackageConfig
fm:[FiniteMap t PackageConfig]
fms) t
q = case FiniteMap t PackageConfig -> t -> Maybe PackageConfig
forall key elt. Ord key => FiniteMap key elt -> key -> Maybe elt
lookupFM FiniteMap t PackageConfig
fm t
q of
            Maybe PackageConfig
Nothing -> [FiniteMap t PackageConfig]
-> t -> IO ([[Char]], ([[Char]], [[Char]]))
go [FiniteMap t PackageConfig]
fms t
q     -- look in other pkgs

            Just PackageConfig
pkg -> do
                let    hslibs :: [[Char]]
hslibs  = PackageConfig -> [[Char]]
hsLibraries PackageConfig
pkg
                       extras' :: [[Char]]
extras' = PackageConfig -> [[Char]]
extraLibraries PackageConfig
pkg
                       cbits :: [[Char]]
cbits   = ([Char] -> Bool) -> [[Char]] -> [[Char]]
forall a. (a -> Bool) -> [a] -> [a]
filter (\[Char]
e -> [Char] -> [Char]
forall a. [a] -> [a]
reverse (Int -> [Char] -> [Char]
forall a. Int -> [a] -> [a]
take ([Char] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
"_cbits") ([Char] -> [Char]
forall a. [a] -> [a]
reverse [Char]
e)) [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"_cbits") [[Char]]
extras'
                       extras :: [[Char]]
extras  = ([Char] -> Bool) -> [[Char]] -> [[Char]]
forall a. (a -> Bool) -> [a] -> [a]
filter (([Char] -> [[Char]] -> Bool) -> [[Char]] -> [Char] -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip [Char] -> [[Char]] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
notElem [[Char]]
cbits) [[Char]]
extras'
                       ldopts :: [[Char]]
ldopts  = PackageConfig -> [[Char]]
ldOptions PackageConfig
pkg
                       deppkgs :: [[Char]]
deppkgs = PackageConfig -> [[Char]]
packageDeps PackageConfig
pkg
                [Maybe LibrarySpec]
ldInput <- ([Char] -> IO (Maybe LibrarySpec))
-> [[Char]] -> IO [Maybe LibrarySpec]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM [Char] -> IO (Maybe LibrarySpec)
classifyLdInput [[Char]]
ldopts
                let ldOptsLibs :: [[Char]]
ldOptsLibs  = [ [Char]
path | Just (DLL [Char]
path) <- [Maybe LibrarySpec]
ldInput ]
                    ldOptsPaths :: [[Char]]
ldOptsPaths = [ [Char]
path | Just (DLLPath [Char]
path) <- [Maybe LibrarySpec]
ldInput ]
                    dlls :: [[Char]]
dlls        = ([Char] -> [Char]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map [Char] -> [Char]
mkSOName ([[Char]]
extras [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [[Char]]
ldOptsLibs)
#if defined(CYGWIN) || defined(__MINGW32__)
                    libdirs = fix_topdir (libraryDirs pkg) ++ ldOptsPaths ++ fix_topdir (libraryDynDirs pkg)
#else
                    libdirs :: [[Char]]
libdirs = PackageConfig -> [[Char]]
libraryDirs PackageConfig
pkg [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [[Char]]
ldOptsPaths [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ PackageConfig -> [[Char]]
libraryDynDirs PackageConfig
pkg
#endif
                -- If we're loading dynamic libs we need the cbits to appear before the
                -- real packages.
#if MIN_VERSION_ghc(8,8,1)
                Settings
settings <- [Char] -> IO Settings
initSysTools ([Char]
libdir)
                LlvmConfig
llvmConfig <- [Char] -> IO LlvmConfig
lazyInitLlvmConfig ([Char]
libdir)
#else
                settings <- initSysTools (Just libdir)
                llvmConfig <- lazyInitLlvmConfig (Just libdir)
#endif
                DynFlags
dflags <- DynFlags -> IO DynFlags
initDynFlags (DynFlags -> IO DynFlags) -> DynFlags -> IO DynFlags
forall a b. (a -> b) -> a -> b
$ Settings -> LlvmConfig -> DynFlags
defaultDynFlags Settings
settings LlvmConfig
llvmConfig
                [Either [Char] HSLib]
libs <- ([Char] -> IO (Either [Char] HSLib))
-> [[Char]] -> IO [Either [Char] HSLib]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Bool -> [[Char]] -> [Char] -> IO (Either [Char] HSLib)
findHSlib
#if MIN_VERSION_ghc(7,8,0)
                              (Way
WayDyn Way -> [Way] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` DynFlags -> [Way]
ways DynFlags
dflags Bool -> Bool -> Bool
|| Bool
dynamicGhc)
#else
                              False
#endif
                              [[Char]]
libdirs)
                             ([[Char]]
cbits [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [[Char]]
hslibs)
#if defined(CYGWIN) || defined(__MINGW32__)
                windowsos <- catch (getEnv "OS")
                           (\e -> if isDoesNotExistError e then return "Windows_98" else ioError e)
                windowsdir <-
                    if windowsos == "Windows_9X" -- I don't know Windows 9X has OS system variable
                      then return "C:/windows"
                      else return "C:/winnt"
                sysroot <- catch (getEnv "SYSTEMROOT")
                           (\e -> if isDoesNotExistError e then return windowsdir else ioError e) -- guess at a reasonable default
                let syslibdir = sysroot ++ (if windowsos == "Windows_9X" then "/SYSTEM" else "/SYSTEM32")
                libs' <- mapM (findDLL $ syslibdir : libdirs) dlls
#else
                [Either [Char] [Char]]
libs' <- ([Char] -> IO (Either [Char] [Char]))
-> [[Char]] -> IO [Either [Char] [Char]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ([[Char]] -> [Char] -> IO (Either [Char] [Char])
findDLL [[Char]]
libdirs) [[Char]]
dlls
#endif
                let slibs :: [[Char]]
slibs = [ [Char]
lib | Right (Static [Char]
lib)  <- [Either [Char] HSLib]
libs ]
                    dlibs :: [[Char]]
dlibs = [ [Char]
lib | Right (Dynamic [Char]
lib) <- [Either [Char] HSLib]
libs ]
                ([[Char]], ([[Char]], [[Char]]))
-> IO ([[Char]], ([[Char]], [[Char]]))
forall (m :: * -> *) a. Monad m => a -> m a
return ([[Char]]
deppkgs, ([[Char]]
slibs,(Either [Char] [Char] -> [Char])
-> [Either [Char] [Char]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map (([Char] -> [Char])
-> ([Char] -> [Char]) -> Either [Char] [Char] -> [Char]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either [Char] -> [Char]
forall a. a -> a
id [Char] -> [Char]
forall a. a -> a
id) [Either [Char] [Char]]
libs' [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [[Char]]
dlibs) )

#if defined(CYGWIN) || defined(__MINGW32__)
        -- replace $topdir
        fix_topdir []        = []
        fix_topdir (x:xs)    = replace_topdir x : fix_topdir xs

        replace_topdir []           = []
        replace_topdir ('$':xs)
            | take 6 xs == "topdir" = ghcLibraryPath ++ (drop 6 xs)
            | otherwise             = '$' : replace_topdir xs
        replace_topdir (x:xs)       = x : replace_topdir xs
#endif
        -- a list elimination form for the Maybe type
        --filterRight :: [Either left right] -> [right]
        --filterRight []           = []
        --filterRight (Right x:xs) = x:filterRight xs
        --filterRight (Left _:xs)  =   filterRight xs

        --
        -- Check that a path to a library actually reaches a library
        findHSlib' :: [FilePath] -> String -> IO (Maybe FilePath)
        findHSlib' :: [[Char]] -> [Char] -> IO (Maybe [Char])
findHSlib' [] [Char]
_           = Maybe [Char] -> IO (Maybe [Char])
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe [Char]
forall a. Maybe a
Nothing
        findHSlib' ([Char]
dir:[[Char]]
dirs) [Char]
lib = do
                  let l :: [Char]
l = [Char]
dir [Char] -> [Char] -> [Char]
</> [Char]
lib
                  Bool
b <- [Char] -> IO Bool
doesFileExist [Char]
l
                  if Bool
b then Maybe [Char] -> IO (Maybe [Char])
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe [Char] -> IO (Maybe [Char]))
-> Maybe [Char] -> IO (Maybe [Char])
forall a b. (a -> b) -> a -> b
$ [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
l     -- found it!
                       else [[Char]] -> [Char] -> IO (Maybe [Char])
findHSlib' [[Char]]
dirs [Char]
lib

        findHSslib :: [[Char]] -> [Char] -> IO (Maybe [Char])
findHSslib [[Char]]
dirs [Char]
lib = [[Char]] -> [Char] -> IO (Maybe [Char])
findHSlib' [[Char]]
dirs ([Char] -> IO (Maybe [Char])) -> [Char] -> IO (Maybe [Char])
forall a b. (a -> b) -> a -> b
$ [Char]
"lib" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
lib [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
sysPkgSuffix
        findHSdlib :: [[Char]] -> [Char] -> IO (Maybe [Char])
findHSdlib [[Char]]
dirs [Char]
lib = [[Char]] -> [Char] -> IO (Maybe [Char])
findHSlib' [[Char]]
dirs ([Char] -> IO (Maybe [Char])) -> [Char] -> IO (Maybe [Char])
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char]
mkDynPkgName [Char]
lib

        findHSlib :: Bool -> [FilePath] -> String -> IO (Either String HSLib)
        findHSlib :: Bool -> [[Char]] -> [Char] -> IO (Either [Char] HSLib)
findHSlib Bool
dynonly [[Char]]
dirs [Char]
lib = do
            -- Problem: sysPkgSuffix  is ".a", but system packages could be dynamic, and
            -- extra dynamic libraries could be needed even when using normal (static) linkage.
            -- Solution: look for dynamic libraries only if using -dynamic; otherwise, use static
            -- and add any other dynamic libraries found.
            Maybe [Char]
dl <- [[Char]] -> [Char] -> IO (Maybe [Char])
findHSdlib [[Char]]
dirs [Char]
lib
            Either [Char] HSLib
rdl <- case Maybe [Char]
dl of
                  Just [Char]
file -> Either [Char] HSLib -> IO (Either [Char] HSLib)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either [Char] HSLib -> IO (Either [Char] HSLib))
-> Either [Char] HSLib -> IO (Either [Char] HSLib)
forall a b. (a -> b) -> a -> b
$ HSLib -> Either [Char] HSLib
forall a b. b -> Either a b
Right (HSLib -> Either [Char] HSLib) -> HSLib -> Either [Char] HSLib
forall a b. (a -> b) -> a -> b
$ [Char] -> HSLib
Dynamic [Char]
file
                  Maybe [Char]
Nothing   -> do
                      -- TODO Generate this suffix automatically. It's absurd we have to use the preprocessor.
                      Maybe [Char]
dynamicSuffix <- [[Char]] -> [Char] -> IO (Maybe [Char])
findHSdlib [[Char]]
dirs ([Char]
lib [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"-ghc" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ ([Char] -> [Char]
forall a. [a] -> [a]
reverse ([Char] -> [Char]) -> [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> [Char] -> [Char]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'-') ([Char] -> [Char]) -> [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char]
forall a. [a] -> [a]
reverse GHC_LIB_PATH))
                      case Maybe [Char]
dynamicSuffix of
                             Just [Char]
file -> Either [Char] HSLib -> IO (Either [Char] HSLib)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either [Char] HSLib -> IO (Either [Char] HSLib))
-> Either [Char] HSLib -> IO (Either [Char] HSLib)
forall a b. (a -> b) -> a -> b
$ HSLib -> Either [Char] HSLib
forall a b. b -> Either a b
Right (HSLib -> Either [Char] HSLib) -> HSLib -> Either [Char] HSLib
forall a b. (a -> b) -> a -> b
$ [Char] -> HSLib
Dynamic [Char]
file
                             Maybe [Char]
Nothing   -> Either [Char] HSLib -> IO (Either [Char] HSLib)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either [Char] HSLib -> IO (Either [Char] HSLib))
-> Either [Char] HSLib -> IO (Either [Char] HSLib)
forall a b. (a -> b) -> a -> b
$ [Char] -> Either [Char] HSLib
forall a b. a -> Either a b
Left [Char]
lib

            if Bool
dynonly then Either [Char] HSLib -> IO (Either [Char] HSLib)
forall (m :: * -> *) a. Monad m => a -> m a
return Either [Char] HSLib
rdl else do
              Maybe [Char]
rsl <- [[Char]] -> [Char] -> IO (Maybe [Char])
findHSslib [[Char]]
dirs [Char]
lib
              Either [Char] HSLib -> IO (Either [Char] HSLib)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either [Char] HSLib -> IO (Either [Char] HSLib))
-> Either [Char] HSLib -> IO (Either [Char] HSLib)
forall a b. (a -> b) -> a -> b
$ case Maybe [Char]
rsl of
                Just [Char]
file -> HSLib -> Either [Char] HSLib
forall a b. b -> Either a b
Right (HSLib -> Either [Char] HSLib) -> HSLib -> Either [Char] HSLib
forall a b. (a -> b) -> a -> b
$ [Char] -> HSLib
Static [Char]
file
                Maybe [Char]
Nothing   -> Either [Char] HSLib
rdl

        findDLL :: [FilePath] -> String -> IO (Either String FilePath)
        findDLL :: [[Char]] -> [Char] -> IO (Either [Char] [Char])
findDLL [] [Char]
lib         = Either [Char] [Char] -> IO (Either [Char] [Char])
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> Either [Char] [Char]
forall a b. a -> Either a b
Left [Char]
lib)
        findDLL ([Char]
dir:[[Char]]
dirs) [Char]
lib = do
                 let l :: [Char]
l = [Char]
dir [Char] -> [Char] -> [Char]
</> [Char]
lib
                 Bool
b <- [Char] -> IO Bool
doesFileExist [Char]
l
                 if Bool
b then Either [Char] [Char] -> IO (Either [Char] [Char])
forall (m :: * -> *) a. Monad m => a -> m a
return (Either [Char] [Char] -> IO (Either [Char] [Char]))
-> Either [Char] [Char] -> IO (Either [Char] [Char])
forall a b. (a -> b) -> a -> b
$ [Char] -> Either [Char] [Char]
forall a b. b -> Either a b
Right [Char]
l
                      else [[Char]] -> [Char] -> IO (Either [Char] [Char])
findDLL [[Char]]
dirs [Char]
lib

------------------------------------------------------------------------
-- do we have a Module name for this merge?
--
isMerged :: FilePath -> FilePath -> IO Bool
isMerged :: [Char] -> [Char] -> IO Bool
isMerged [Char]
a [Char]
b = Env -> (MergeEnv -> IO Bool) -> IO Bool
forall a. Env -> (MergeEnv -> IO a) -> IO a
withMerged Env
forall key elt key elt key elt.
(MVar (), IORef (FiniteMap key elt), IORef (FiniteMap key elt),
 IORef PkgEnvs, IORef (Set [Char]), IORef (FiniteMap key elt))
env ((MergeEnv -> IO Bool) -> IO Bool)
-> (MergeEnv -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \MergeEnv
fm -> Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> IO Bool) -> Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ Maybe [Char] -> Bool
forall a. Maybe a -> Bool
isJust (MergeEnv -> ([Char], [Char]) -> Maybe [Char]
forall key elt. Ord key => FiniteMap key elt -> key -> Maybe elt
lookupFM MergeEnv
fm ([Char]
a,[Char]
b))

lookupMerged :: FilePath -> FilePath -> IO (Maybe FilePath)
lookupMerged :: [Char] -> [Char] -> IO (Maybe [Char])
lookupMerged [Char]
a [Char]
b = Env -> (MergeEnv -> IO (Maybe [Char])) -> IO (Maybe [Char])
forall a. Env -> (MergeEnv -> IO a) -> IO a
withMerged Env
forall key elt key elt key elt.
(MVar (), IORef (FiniteMap key elt), IORef (FiniteMap key elt),
 IORef PkgEnvs, IORef (Set [Char]), IORef (FiniteMap key elt))
env ((MergeEnv -> IO (Maybe [Char])) -> IO (Maybe [Char]))
-> (MergeEnv -> IO (Maybe [Char])) -> IO (Maybe [Char])
forall a b. (a -> b) -> a -> b
$ \MergeEnv
fm -> Maybe [Char] -> IO (Maybe [Char])
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe [Char] -> IO (Maybe [Char]))
-> Maybe [Char] -> IO (Maybe [Char])
forall a b. (a -> b) -> a -> b
$ MergeEnv -> ([Char], [Char]) -> Maybe [Char]
forall key elt. Ord key => FiniteMap key elt -> key -> Maybe elt
lookupFM MergeEnv
fm ([Char]
a,[Char]
b)

--
-- insert a new merge pair into env
--
addMerge :: FilePath -> FilePath -> FilePath -> IO ()
addMerge :: [Char] -> [Char] -> [Char] -> IO ()
addMerge [Char]
a [Char]
b [Char]
z = Env -> (MergeEnv -> IO MergeEnv) -> IO ()
modifyMerged Env
forall key elt key elt key elt.
(MVar (), IORef (FiniteMap key elt), IORef (FiniteMap key elt),
 IORef PkgEnvs, IORef (Set [Char]), IORef (FiniteMap key elt))
env ((MergeEnv -> IO MergeEnv) -> IO ())
-> (MergeEnv -> IO MergeEnv) -> IO ()
forall a b. (a -> b) -> a -> b
$ \MergeEnv
fm -> MergeEnv -> IO MergeEnv
forall (m :: * -> *) a. Monad m => a -> m a
return (MergeEnv -> IO MergeEnv) -> MergeEnv -> IO MergeEnv
forall a b. (a -> b) -> a -> b
$ MergeEnv -> ([Char], [Char]) -> [Char] -> MergeEnv
forall key elt.
Ord key =>
FiniteMap key elt -> key -> elt -> FiniteMap key elt
addToFM MergeEnv
fm ([Char]
a,[Char]
b) [Char]
z

------------------------------------------------------------------------
-- break a module cycle
-- private:
--
(</>) :: FilePath -> FilePath -> FilePath
[] </> :: [Char] -> [Char] -> [Char]
</> [Char]
b = [Char]
b
[Char]
a  </> [Char]
b = [Char]
a [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"/" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
b


------------------------------------------------------------------------

--
-- We export an abstract interface to package conf`s because we have
-- to handle either traditional or Cabal style package conf`s.
--



packageName    :: PackageConfig -> PackageName
packageDeps    :: PackageConfig -> [PackageName]
-- updImportDirs  :: ([FilePath] -> [FilePath]) -> PackageConfig -> PackageConfig
-- updLibraryDirs :: ([FilePath] -> [FilePath]) -> PackageConfig -> PackageConfig


type PackageName = String

type PackageConfig = InstalledPackageInfo

packageName :: PackageConfig -> [Char]
packageName = PackageName -> [Char]
forall a. Pretty a => a -> [Char]
display (PackageName -> [Char])
-> (PackageConfig -> PackageName) -> PackageConfig -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageId -> PackageName
pkgName (PackageId -> PackageName)
-> (PackageConfig -> PackageId) -> PackageConfig -> PackageName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageConfig -> PackageId
sourcePackageId
-- packageName_ = pkgName . sourcePackageId
packageDeps :: PackageConfig -> [[Char]]
packageDeps = ((UnitId -> [Char]) -> [UnitId] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map UnitId -> [Char]
forall a. Pretty a => a -> [Char]
display) ([UnitId] -> [[Char]])
-> (PackageConfig -> [UnitId]) -> PackageConfig -> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageConfig -> [UnitId]
depends

{-
updImportDirs f pk@(InstalledPackageInfo { importDirs = idirs }) =
        pk { importDirs = f idirs }
updLibraryDirs f pk@(InstalledPackageInfo { libraryDirs = ldirs }) =
        pk { libraryDirs = f ldirs }
-}