{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}

module Stack.Types.ConfigureOpts
  ( ConfigureOpts (..)
  , BaseConfigOpts (..)
  , configureOpts
  , configureOptsDirs
  , configureOptsNoDir
  ) where

import qualified Data.Map as Map
import qualified Data.Text as T
import           Distribution.Types.MungedPackageName
                   ( decodeCompatPackageName )
import           Distribution.Types.PackageName ( unPackageName )
import           Distribution.Types.UnqualComponentName
                   ( unUnqualComponentName )
import qualified Distribution.Version as C
import           Path ( (</>), parseRelDir )
import           Path.Extra ( toFilePathNoTrailingSep )
import           Stack.Constants
                   ( bindirSuffix, compilerOptionsCabalFlag, docDirSuffix
                   , relDirEtc, relDirLib, relDirLibexec, relDirShare
                   )
import           Stack.Prelude
import           Stack.Types.BuildOpts ( BuildOpts (..), BuildOptsCLI )
import           Stack.Types.Compiler ( getGhcVersion, whichCompiler )
import           Stack.Types.Config
                   ( Config (..), HasConfig (..) )
import           Stack.Types.EnvConfig ( EnvConfig, actualCompilerVersionL )
import           Stack.Types.GhcPkgId ( GhcPkgId, ghcPkgIdString )
import           Stack.Types.IsMutable ( IsMutable (..) )
import           Stack.Types.Package ( Package (..) )
import           System.FilePath ( pathSeparator )

-- | Basic information used to calculate what the configure options are

data BaseConfigOpts = BaseConfigOpts
  { BaseConfigOpts -> Path Abs Dir
bcoSnapDB :: !(Path Abs Dir)
  , BaseConfigOpts -> Path Abs Dir
bcoLocalDB :: !(Path Abs Dir)
  , BaseConfigOpts -> Path Abs Dir
bcoSnapInstallRoot :: !(Path Abs Dir)
  , BaseConfigOpts -> Path Abs Dir
bcoLocalInstallRoot :: !(Path Abs Dir)
  , BaseConfigOpts -> BuildOpts
bcoBuildOpts :: !BuildOpts
  , BaseConfigOpts -> BuildOptsCLI
bcoBuildOptsCLI :: !BuildOptsCLI
  , BaseConfigOpts -> [Path Abs Dir]
bcoExtraDBs :: ![Path Abs Dir]
  }
  deriving Int -> BaseConfigOpts -> ShowS
[BaseConfigOpts] -> ShowS
BaseConfigOpts -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BaseConfigOpts] -> ShowS
$cshowList :: [BaseConfigOpts] -> ShowS
show :: BaseConfigOpts -> String
$cshow :: BaseConfigOpts -> String
showsPrec :: Int -> BaseConfigOpts -> ShowS
$cshowsPrec :: Int -> BaseConfigOpts -> ShowS
Show

-- | Render a @BaseConfigOpts@ to an actual list of options

configureOpts :: EnvConfig
              -> BaseConfigOpts
              -> Map PackageIdentifier GhcPkgId -- ^ dependencies

              -> Bool -- ^ local non-extra-dep?

              -> IsMutable
              -> Package
              -> ConfigureOpts
configureOpts :: EnvConfig
-> BaseConfigOpts
-> Map PackageIdentifier GhcPkgId
-> Bool
-> IsMutable
-> Package
-> ConfigureOpts
configureOpts EnvConfig
econfig BaseConfigOpts
bco Map PackageIdentifier GhcPkgId
deps Bool
isLocal IsMutable
isMutable Package
package = ConfigureOpts
  { coDirs :: [String]
coDirs = BaseConfigOpts -> IsMutable -> Package -> [String]
configureOptsDirs BaseConfigOpts
bco IsMutable
isMutable Package
package
  , coNoDirs :: [String]
coNoDirs = EnvConfig
-> BaseConfigOpts
-> Map PackageIdentifier GhcPkgId
-> Bool
-> Package
-> [String]
configureOptsNoDir EnvConfig
econfig BaseConfigOpts
bco Map PackageIdentifier GhcPkgId
deps Bool
isLocal Package
package
  }


configureOptsDirs :: BaseConfigOpts
                  -> IsMutable
                  -> Package
                  -> [String]
configureOptsDirs :: BaseConfigOpts -> IsMutable -> Package -> [String]
configureOptsDirs BaseConfigOpts
bco IsMutable
isMutable Package
package = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
  [ [String
"--user", String
"--package-db=clear", String
"--package-db=global"]
  , forall a b. (a -> b) -> [a] -> [b]
map ((String
"--package-db=" ++) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall loc. Path loc Dir -> String
toFilePathNoTrailingSep) forall a b. (a -> b) -> a -> b
$ case IsMutable
isMutable of
      IsMutable
Immutable -> BaseConfigOpts -> [Path Abs Dir]
bcoExtraDBs BaseConfigOpts
bco forall a. [a] -> [a] -> [a]
++ [BaseConfigOpts -> Path Abs Dir
bcoSnapDB BaseConfigOpts
bco]
      IsMutable
Mutable -> BaseConfigOpts -> [Path Abs Dir]
bcoExtraDBs BaseConfigOpts
bco forall a. [a] -> [a] -> [a]
++ [BaseConfigOpts -> Path Abs Dir
bcoSnapDB BaseConfigOpts
bco] forall a. [a] -> [a] -> [a]
++ [BaseConfigOpts -> Path Abs Dir
bcoLocalDB BaseConfigOpts
bco]
  , [ String
"--libdir=" forall a. [a] -> [a] -> [a]
++ forall loc. Path loc Dir -> String
toFilePathNoTrailingSep (Path Abs Dir
installRoot forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel Dir
relDirLib)
    , String
"--bindir=" forall a. [a] -> [a] -> [a]
++ forall loc. Path loc Dir -> String
toFilePathNoTrailingSep (Path Abs Dir
installRoot forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel Dir
bindirSuffix)
    , String
"--datadir=" forall a. [a] -> [a] -> [a]
++ forall loc. Path loc Dir -> String
toFilePathNoTrailingSep (Path Abs Dir
installRoot forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel Dir
relDirShare)
    , String
"--libexecdir=" forall a. [a] -> [a] -> [a]
++ forall loc. Path loc Dir -> String
toFilePathNoTrailingSep (Path Abs Dir
installRoot forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel Dir
relDirLibexec)
    , String
"--sysconfdir=" forall a. [a] -> [a] -> [a]
++ forall loc. Path loc Dir -> String
toFilePathNoTrailingSep (Path Abs Dir
installRoot forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel Dir
relDirEtc)
    , String
"--docdir=" forall a. [a] -> [a] -> [a]
++ forall loc. Path loc Dir -> String
toFilePathNoTrailingSep Path Abs Dir
docDir
    , String
"--htmldir=" forall a. [a] -> [a] -> [a]
++ forall loc. Path loc Dir -> String
toFilePathNoTrailingSep Path Abs Dir
docDir
    , String
"--haddockdir=" forall a. [a] -> [a] -> [a]
++ forall loc. Path loc Dir -> String
toFilePathNoTrailingSep Path Abs Dir
docDir]
  ]
 where
  installRoot :: Path Abs Dir
installRoot =
    case IsMutable
isMutable of
      IsMutable
Immutable -> BaseConfigOpts -> Path Abs Dir
bcoSnapInstallRoot BaseConfigOpts
bco
      IsMutable
Mutable -> BaseConfigOpts -> Path Abs Dir
bcoLocalInstallRoot BaseConfigOpts
bco
  docDir :: Path Abs Dir
docDir =
    case Maybe (Path Rel Dir)
pkgVerDir of
      Maybe (Path Rel Dir)
Nothing -> Path Abs Dir
installRoot forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel Dir
docDirSuffix
      Just Path Rel Dir
dir -> Path Abs Dir
installRoot forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel Dir
docDirSuffix forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel Dir
dir
  pkgVerDir :: Maybe (Path Rel Dir)
pkgVerDir = forall (m :: * -> *). MonadThrow m => String -> m (Path Rel Dir)
parseRelDir
    (  PackageIdentifier -> String
packageIdentifierString
        (PackageName -> Version -> PackageIdentifier
PackageIdentifier (Package -> PackageName
packageName Package
package) (Package -> Version
packageVersion Package
package))
    forall a. [a] -> [a] -> [a]
++ [Char
pathSeparator]
    )

-- | Same as 'configureOpts', but does not include directory path options

configureOptsNoDir ::
     EnvConfig
  -> BaseConfigOpts
  -> Map PackageIdentifier GhcPkgId -- ^ Dependencies.

  -> Bool -- ^ Is this a local, non-extra-dep?

  -> Package
  -> [String]
configureOptsNoDir :: EnvConfig
-> BaseConfigOpts
-> Map PackageIdentifier GhcPkgId
-> Bool
-> Package
-> [String]
configureOptsNoDir EnvConfig
econfig BaseConfigOpts
bco Map PackageIdentifier GhcPkgId
deps Bool
isLocal Package
package = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
  [ [String]
depOptions
  , [ String
"--enable-library-profiling"
    | BuildOpts -> Bool
boptsLibProfile BuildOpts
bopts Bool -> Bool -> Bool
|| BuildOpts -> Bool
boptsExeProfile BuildOpts
bopts
    ]
  , [String
"--enable-profiling" | BuildOpts -> Bool
boptsExeProfile BuildOpts
bopts Bool -> Bool -> Bool
&& Bool
isLocal]
  , [String
"--enable-split-objs" | BuildOpts -> Bool
boptsSplitObjs BuildOpts
bopts]
  , [ String
"--disable-library-stripping"
    | Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ BuildOpts -> Bool
boptsLibStrip BuildOpts
bopts Bool -> Bool -> Bool
|| BuildOpts -> Bool
boptsExeStrip BuildOpts
bopts
    ]
  , [String
"--disable-executable-stripping" | Bool -> Bool
not (BuildOpts -> Bool
boptsExeStrip BuildOpts
bopts) Bool -> Bool -> Bool
&& Bool
isLocal]
  , forall a b. (a -> b) -> [a] -> [b]
map (\(FlagName
name,Bool
enabled) ->
                     String
"-f" forall a. Semigroup a => a -> a -> a
<>
                     (if Bool
enabled
                        then String
""
                        else String
"-") forall a. Semigroup a => a -> a -> a
<>
                     FlagName -> String
flagNameString FlagName
name)
                  (forall k a. Map k a -> [(k, a)]
Map.toList Map FlagName Bool
flags)
  , forall a b. (a -> b) -> [a] -> [b]
map Text -> String
T.unpack forall a b. (a -> b) -> a -> b
$ Package -> [Text]
packageCabalConfigOpts Package
package
  , [Text] -> [String]
processGhcOptions (Package -> [Text]
packageGhcOptions Package
package)
  , forall a b. (a -> b) -> [a] -> [b]
map (String
"--extra-include-dirs=" ++) (Config -> [String]
configExtraIncludeDirs Config
config)
  , forall a b. (a -> b) -> [a] -> [b]
map (String
"--extra-lib-dirs=" ++) (Config -> [String]
configExtraLibDirs Config
config)
  , forall b a. b -> (a -> b) -> Maybe a -> b
maybe
      []
      (\Path Abs File
customGcc -> [String
"--with-gcc=" forall a. [a] -> [a] -> [a]
++ forall b t. Path b t -> String
toFilePath Path Abs File
customGcc])
      (Config -> Maybe (Path Abs File)
configOverrideGccPath Config
config)
  , [String
"--exact-configuration"]
  , [String
"--ghc-option=-fhide-source-paths" | Version -> Bool
hideSourcePaths Version
cv]
  ]
 where
  -- This function parses the GHC options that are providing in the

  -- stack.yaml file. In order to handle RTS arguments correctly, we need

  -- to provide the RTS arguments as a single argument.

  processGhcOptions :: [Text] -> [String]
  processGhcOptions :: [Text] -> [String]
processGhcOptions [Text]
args =
    let ([Text]
preRtsArgs, [Text]
mid) = forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Text
"+RTS" ==) [Text]
args
        ([Text]
rtsArgs, [Text]
end) = forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Text
"-RTS" ==) [Text]
mid
        fullRtsArgs :: [Text]
fullRtsArgs =
          case [Text]
rtsArgs of
            [] ->
              -- This means that we didn't have any RTS args - no `+RTS` - and

              -- therefore no need for a `-RTS`.

              []
            [Text]
_ ->
              -- In this case, we have some RTS args. `break` puts the `"-RTS"`

              -- string in the `snd` list, so we want to append it on the end of

              -- `rtsArgs` here.

              --

              -- We're not checking that `-RTS` is the first element of `end`.

              -- This is because the GHC RTS allows you to omit a trailing -RTS

              -- if that's the last of the arguments. This permits a GHC options

              -- in stack.yaml that matches what you might pass directly to GHC.

              [[Text] -> Text
T.unwords forall a b. (a -> b) -> a -> b
$ [Text]
rtsArgs forall a. [a] -> [a] -> [a]
++ [Text
"-RTS"]]
        -- We drop the first element from `end`, because it is always either

        -- `"-RTS"` (and we don't want that as a separate argument) or the list

        -- is empty (and `drop _ [] = []`).

        postRtsArgs :: [Text]
postRtsArgs = forall a. Int -> [a] -> [a]
drop Int
1 [Text]
end
        newArgs :: [Text]
newArgs = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Text]
preRtsArgs, [Text]
fullRtsArgs, [Text]
postRtsArgs]
    in  forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\Text
x -> [WhichCompiler -> String
compilerOptionsCabalFlag WhichCompiler
wc, Text -> String
T.unpack Text
x]) [Text]
newArgs

  wc :: WhichCompiler
wc = forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (forall env. HasSourceMap env => SimpleGetter env ActualCompiler
actualCompilerVersionLforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall s a. (s -> a) -> SimpleGetter s a
to ActualCompiler -> WhichCompiler
whichCompiler) EnvConfig
econfig
  cv :: Version
cv = forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (forall env. HasSourceMap env => SimpleGetter env ActualCompiler
actualCompilerVersionLforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall s a. (s -> a) -> SimpleGetter s a
to ActualCompiler -> Version
getGhcVersion) EnvConfig
econfig

  hideSourcePaths :: Version -> Bool
hideSourcePaths Version
ghcVersion =
    Version
ghcVersion forall a. Ord a => a -> a -> Bool
>= [Int] -> Version
C.mkVersion [Int
8, Int
2] Bool -> Bool -> Bool
&& Config -> Bool
configHideSourcePaths Config
config

  config :: Config
config = forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall env. HasConfig env => Lens' env Config
configL EnvConfig
econfig
  bopts :: BuildOpts
bopts = BaseConfigOpts -> BuildOpts
bcoBuildOpts BaseConfigOpts
bco

  -- Unioning atop defaults is needed so that all flags are specified with

  -- --exact-configuration.

  flags :: Map FlagName Bool
flags = Package -> Map FlagName Bool
packageFlags Package
package forall k a. Ord k => Map k a -> Map k a -> Map k a
`Map.union` Package -> Map FlagName Bool
packageDefaultFlags Package
package

  depOptions :: [String]
depOptions = forall a b. (a -> b) -> [a] -> [b]
map (PackageIdentifier, GhcPkgId) -> String
toDepOption forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> [(k, a)]
Map.toList Map PackageIdentifier GhcPkgId
deps

  toDepOption :: (PackageIdentifier, GhcPkgId) -> String
toDepOption (PackageIdentifier PackageName
name Version
_, GhcPkgId
gid) = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
    [ String
"--dependency="
    , String
depOptionKey
    , String
"="
    , GhcPkgId -> String
ghcPkgIdString GhcPkgId
gid
    ]
   where
    MungedPackageName PackageName
subPkgName LibraryName
lib = PackageName -> MungedPackageName
decodeCompatPackageName PackageName
name
    depOptionKey :: String
depOptionKey = case LibraryName
lib of
      LibraryName
LMainLibName -> PackageName -> String
unPackageName PackageName
name
      LSubLibName UnqualComponentName
cn ->
        PackageName -> String
unPackageName PackageName
subPkgName forall a. Semigroup a => a -> a -> a
<> String
":" forall a. Semigroup a => a -> a -> a
<> UnqualComponentName -> String
unUnqualComponentName UnqualComponentName
cn

-- | Configure options to be sent to Setup.hs configure

data ConfigureOpts = ConfigureOpts
  { ConfigureOpts -> [String]
coDirs :: ![String]
    -- ^ Options related to various paths. We separate these out since they do

    -- not have an impact on the contents of the compiled binary for checking

    -- if we can use an existing precompiled cache.

  , ConfigureOpts -> [String]
coNoDirs :: ![String]
  }
  deriving (Typeable ConfigureOpts
ConfigureOpts -> DataType
ConfigureOpts -> Constr
(forall b. Data b => b -> b) -> ConfigureOpts -> ConfigureOpts
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> ConfigureOpts -> u
forall u. (forall d. Data d => d -> u) -> ConfigureOpts -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ConfigureOpts -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ConfigureOpts -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ConfigureOpts -> m ConfigureOpts
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ConfigureOpts -> m ConfigureOpts
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ConfigureOpts
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ConfigureOpts -> c ConfigureOpts
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ConfigureOpts)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ConfigureOpts)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ConfigureOpts -> m ConfigureOpts
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ConfigureOpts -> m ConfigureOpts
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ConfigureOpts -> m ConfigureOpts
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ConfigureOpts -> m ConfigureOpts
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ConfigureOpts -> m ConfigureOpts
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ConfigureOpts -> m ConfigureOpts
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ConfigureOpts -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ConfigureOpts -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> ConfigureOpts -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> ConfigureOpts -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ConfigureOpts -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ConfigureOpts -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ConfigureOpts -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ConfigureOpts -> r
gmapT :: (forall b. Data b => b -> b) -> ConfigureOpts -> ConfigureOpts
$cgmapT :: (forall b. Data b => b -> b) -> ConfigureOpts -> ConfigureOpts
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ConfigureOpts)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ConfigureOpts)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ConfigureOpts)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ConfigureOpts)
dataTypeOf :: ConfigureOpts -> DataType
$cdataTypeOf :: ConfigureOpts -> DataType
toConstr :: ConfigureOpts -> Constr
$ctoConstr :: ConfigureOpts -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ConfigureOpts
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ConfigureOpts
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ConfigureOpts -> c ConfigureOpts
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ConfigureOpts -> c ConfigureOpts
Data, ConfigureOpts -> ConfigureOpts -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ConfigureOpts -> ConfigureOpts -> Bool
$c/= :: ConfigureOpts -> ConfigureOpts -> Bool
== :: ConfigureOpts -> ConfigureOpts -> Bool
$c== :: ConfigureOpts -> ConfigureOpts -> Bool
Eq, forall x. Rep ConfigureOpts x -> ConfigureOpts
forall x. ConfigureOpts -> Rep ConfigureOpts x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ConfigureOpts x -> ConfigureOpts
$cfrom :: forall x. ConfigureOpts -> Rep ConfigureOpts x
Generic, Int -> ConfigureOpts -> ShowS
[ConfigureOpts] -> ShowS
ConfigureOpts -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ConfigureOpts] -> ShowS
$cshowList :: [ConfigureOpts] -> ShowS
show :: ConfigureOpts -> String
$cshow :: ConfigureOpts -> String
showsPrec :: Int -> ConfigureOpts -> ShowS
$cshowsPrec :: Int -> ConfigureOpts -> ShowS
Show, Typeable)

instance NFData ConfigureOpts