module GHC.Driver.Config.Finder (
    FinderOpts(..),
    initFinderOpts
  ) where

import GHC.Prelude

import GHC.Driver.DynFlags
import GHC.Unit.Finder.Types
import GHC.Data.FastString
import GHC.Data.OsPath
import qualified Data.Map as Map

-- | Create a new 'FinderOpts' from DynFlags.
initFinderOpts :: DynFlags -> FinderOpts
initFinderOpts :: DynFlags -> FinderOpts
initFinderOpts DynFlags
flags = FinderOpts
  { finder_importPaths :: [OsPath]
finder_importPaths = (FilePath -> OsPath) -> [FilePath] -> [OsPath]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap HasCallStack => FilePath -> OsPath
FilePath -> OsPath
unsafeEncodeUtf ([FilePath] -> [OsPath]) -> [FilePath] -> [OsPath]
forall a b. (a -> b) -> a -> b
$ DynFlags -> [FilePath]
importPaths DynFlags
flags
  , finder_lookupHomeInterfaces :: Bool
finder_lookupHomeInterfaces = GhcMode -> Bool
isOneShot (DynFlags -> GhcMode
ghcMode DynFlags
flags)
  , finder_bypassHiFileCheck :: Bool
finder_bypassHiFileCheck = GhcMode
MkDepend GhcMode -> GhcMode -> Bool
forall a. Eq a => a -> a -> Bool
== (DynFlags -> GhcMode
ghcMode DynFlags
flags)
  , finder_ways :: Ways
finder_ways = DynFlags -> Ways
ways DynFlags
flags
  , finder_enableSuggestions :: Bool
finder_enableSuggestions = GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_HelpfulErrors DynFlags
flags
  , finder_workingDirectory :: Maybe OsPath
finder_workingDirectory = (FilePath -> OsPath) -> Maybe FilePath -> Maybe OsPath
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap HasCallStack => FilePath -> OsPath
FilePath -> OsPath
unsafeEncodeUtf (Maybe FilePath -> Maybe OsPath) -> Maybe FilePath -> Maybe OsPath
forall a b. (a -> b) -> a -> b
$ DynFlags -> Maybe FilePath
workingDirectory DynFlags
flags
  , finder_thisPackageName :: Maybe FastString
finder_thisPackageName  = FilePath -> FastString
mkFastString (FilePath -> FastString) -> Maybe FilePath -> Maybe FastString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DynFlags -> Maybe FilePath
thisPackageName DynFlags
flags
  , finder_hiddenModules :: Set ModuleName
finder_hiddenModules = DynFlags -> Set ModuleName
hiddenModules DynFlags
flags
  , finder_reexportedModules :: Map ModuleName ModuleName
finder_reexportedModules = [(ModuleName, ModuleName)] -> Map ModuleName ModuleName
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(ModuleName
known_as, ModuleName
is_as) | ReexportedModule ModuleName
is_as ModuleName
known_as <- [ReexportedModule] -> [ReexportedModule]
forall a. [a] -> [a]
reverse (DynFlags -> [ReexportedModule]
reexportedModules DynFlags
flags)]
  , finder_hieDir :: Maybe OsPath
finder_hieDir = (FilePath -> OsPath) -> Maybe FilePath -> Maybe OsPath
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap HasCallStack => FilePath -> OsPath
FilePath -> OsPath
unsafeEncodeUtf (Maybe FilePath -> Maybe OsPath) -> Maybe FilePath -> Maybe OsPath
forall a b. (a -> b) -> a -> b
$ DynFlags -> Maybe FilePath
hieDir DynFlags
flags
  , finder_hieSuf :: OsPath
finder_hieSuf = HasCallStack => FilePath -> OsPath
FilePath -> OsPath
unsafeEncodeUtf (FilePath -> OsPath) -> FilePath -> OsPath
forall a b. (a -> b) -> a -> b
$ DynFlags -> FilePath
hieSuf DynFlags
flags
  , finder_hiDir :: Maybe OsPath
finder_hiDir = (FilePath -> OsPath) -> Maybe FilePath -> Maybe OsPath
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap HasCallStack => FilePath -> OsPath
FilePath -> OsPath
unsafeEncodeUtf (Maybe FilePath -> Maybe OsPath) -> Maybe FilePath -> Maybe OsPath
forall a b. (a -> b) -> a -> b
$ DynFlags -> Maybe FilePath
hiDir DynFlags
flags
  , finder_hiSuf :: OsPath
finder_hiSuf = HasCallStack => FilePath -> OsPath
FilePath -> OsPath
unsafeEncodeUtf (FilePath -> OsPath) -> FilePath -> OsPath
forall a b. (a -> b) -> a -> b
$ DynFlags -> FilePath
hiSuf_ DynFlags
flags
  , finder_dynHiSuf :: OsPath
finder_dynHiSuf = HasCallStack => FilePath -> OsPath
FilePath -> OsPath
unsafeEncodeUtf (FilePath -> OsPath) -> FilePath -> OsPath
forall a b. (a -> b) -> a -> b
$ DynFlags -> FilePath
dynHiSuf_ DynFlags
flags
  , finder_objectDir :: Maybe OsPath
finder_objectDir = (FilePath -> OsPath) -> Maybe FilePath -> Maybe OsPath
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap HasCallStack => FilePath -> OsPath
FilePath -> OsPath
unsafeEncodeUtf (Maybe FilePath -> Maybe OsPath) -> Maybe FilePath -> Maybe OsPath
forall a b. (a -> b) -> a -> b
$ DynFlags -> Maybe FilePath
objectDir DynFlags
flags
  , finder_objectSuf :: OsPath
finder_objectSuf = HasCallStack => FilePath -> OsPath
FilePath -> OsPath
unsafeEncodeUtf (FilePath -> OsPath) -> FilePath -> OsPath
forall a b. (a -> b) -> a -> b
$ DynFlags -> FilePath
objectSuf_ DynFlags
flags
  , finder_dynObjectSuf :: OsPath
finder_dynObjectSuf = HasCallStack => FilePath -> OsPath
FilePath -> OsPath
unsafeEncodeUtf (FilePath -> OsPath) -> FilePath -> OsPath
forall a b. (a -> b) -> a -> b
$ DynFlags -> FilePath
dynObjectSuf_ DynFlags
flags
  , finder_stubDir :: Maybe OsPath
finder_stubDir = (FilePath -> OsPath) -> Maybe FilePath -> Maybe OsPath
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap HasCallStack => FilePath -> OsPath
FilePath -> OsPath
unsafeEncodeUtf (Maybe FilePath -> Maybe OsPath) -> Maybe FilePath -> Maybe OsPath
forall a b. (a -> b) -> a -> b
$ DynFlags -> Maybe FilePath
stubDir DynFlags
flags
  }