{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RankNTypes #-}
module Distribution.Simple.Setup.Install
( InstallFlags (..)
, emptyInstallFlags
, defaultInstallFlags
, installCommand
) where
import Distribution.Compat.Prelude hiding (get)
import Prelude ()
import Distribution.ReadE
import Distribution.Simple.Command hiding (boolOpt, boolOpt')
import Distribution.Simple.Compiler
import Distribution.Simple.Flag
import Distribution.Simple.InstallDirs
import Distribution.Simple.Utils
import Distribution.Verbosity
import Distribution.Simple.Setup.Common
data InstallFlags = InstallFlags
{ InstallFlags -> Flag PackageDB
installPackageDB :: Flag PackageDB
, InstallFlags -> Flag CopyDest
installDest :: Flag CopyDest
, InstallFlags -> Flag FilePath
installDistPref :: Flag FilePath
, InstallFlags -> Flag Bool
installUseWrapper :: Flag Bool
, InstallFlags -> Flag Bool
installInPlace :: Flag Bool
, InstallFlags -> Flag Verbosity
installVerbosity :: Flag Verbosity
,
InstallFlags -> Flag FilePath
installCabalFilePath :: Flag FilePath
}
deriving (Int -> InstallFlags -> ShowS
[InstallFlags] -> ShowS
InstallFlags -> FilePath
(Int -> InstallFlags -> ShowS)
-> (InstallFlags -> FilePath)
-> ([InstallFlags] -> ShowS)
-> Show InstallFlags
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> InstallFlags -> ShowS
showsPrec :: Int -> InstallFlags -> ShowS
$cshow :: InstallFlags -> FilePath
show :: InstallFlags -> FilePath
$cshowList :: [InstallFlags] -> ShowS
showList :: [InstallFlags] -> ShowS
Show, (forall x. InstallFlags -> Rep InstallFlags x)
-> (forall x. Rep InstallFlags x -> InstallFlags)
-> Generic InstallFlags
forall x. Rep InstallFlags x -> InstallFlags
forall x. InstallFlags -> Rep InstallFlags x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. InstallFlags -> Rep InstallFlags x
from :: forall x. InstallFlags -> Rep InstallFlags x
$cto :: forall x. Rep InstallFlags x -> InstallFlags
to :: forall x. Rep InstallFlags x -> InstallFlags
Generic)
defaultInstallFlags :: InstallFlags
defaultInstallFlags :: InstallFlags
defaultInstallFlags =
InstallFlags
{ installPackageDB :: Flag PackageDB
installPackageDB = Flag PackageDB
forall a. Flag a
NoFlag
, installDest :: Flag CopyDest
installDest = CopyDest -> Flag CopyDest
forall a. a -> Flag a
Flag CopyDest
NoCopyDest
, installDistPref :: Flag FilePath
installDistPref = Flag FilePath
forall a. Flag a
NoFlag
, installUseWrapper :: Flag Bool
installUseWrapper = Bool -> Flag Bool
forall a. a -> Flag a
Flag Bool
False
, installInPlace :: Flag Bool
installInPlace = Bool -> Flag Bool
forall a. a -> Flag a
Flag Bool
False
, installVerbosity :: Flag Verbosity
installVerbosity = Verbosity -> Flag Verbosity
forall a. a -> Flag a
Flag Verbosity
normal
, installCabalFilePath :: Flag FilePath
installCabalFilePath = Flag FilePath
forall a. Monoid a => a
mempty
}
installCommand :: CommandUI InstallFlags
installCommand :: CommandUI InstallFlags
installCommand =
CommandUI
{ commandName :: FilePath
commandName = FilePath
"install"
, commandSynopsis :: FilePath
commandSynopsis =
FilePath
"Copy the files into the install locations. Run register."
, commandDescription :: Maybe ShowS
commandDescription = ShowS -> Maybe ShowS
forall a. a -> Maybe a
Just (ShowS -> Maybe ShowS) -> ShowS -> Maybe ShowS
forall a b. (a -> b) -> a -> b
$ \FilePath
_ ->
ShowS
wrapText ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
FilePath
"Unlike the copy command, install calls the register command. "
FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
"If you want to install into a location that is not what was "
FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
"specified in the configure step, use the copy command.\n"
, commandNotes :: Maybe ShowS
commandNotes = Maybe ShowS
forall a. Maybe a
Nothing
, commandUsage :: ShowS
commandUsage = \FilePath
pname ->
FilePath
"Usage: " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
pname FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
" install [FLAGS]\n"
, commandDefaultFlags :: InstallFlags
commandDefaultFlags = InstallFlags
defaultInstallFlags
, commandOptions :: ShowOrParseArgs -> [OptionField InstallFlags]
commandOptions = \ShowOrParseArgs
showOrParseArgs -> case ShowOrParseArgs
showOrParseArgs of
ShowOrParseArgs
ShowArgs ->
(OptionField InstallFlags -> Bool)
-> [OptionField InstallFlags] -> [OptionField InstallFlags]
forall a. (a -> Bool) -> [a] -> [a]
filter
( (FilePath -> [FilePath] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [FilePath
"target-package-db"])
(FilePath -> Bool)
-> (OptionField InstallFlags -> FilePath)
-> OptionField InstallFlags
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OptionField InstallFlags -> FilePath
forall a. OptionField a -> FilePath
optionName
)
([OptionField InstallFlags] -> [OptionField InstallFlags])
-> [OptionField InstallFlags] -> [OptionField InstallFlags]
forall a b. (a -> b) -> a -> b
$ ShowOrParseArgs -> [OptionField InstallFlags]
installOptions ShowOrParseArgs
ShowArgs
ShowOrParseArgs
ParseArgs -> ShowOrParseArgs -> [OptionField InstallFlags]
installOptions ShowOrParseArgs
ParseArgs
}
installOptions :: ShowOrParseArgs -> [OptionField InstallFlags]
installOptions :: ShowOrParseArgs -> [OptionField InstallFlags]
installOptions ShowOrParseArgs
showOrParseArgs =
[ (InstallFlags -> Flag Verbosity)
-> (Flag Verbosity -> InstallFlags -> InstallFlags)
-> OptionField InstallFlags
forall flags.
(flags -> Flag Verbosity)
-> (Flag Verbosity -> flags -> flags) -> OptionField flags
optionVerbosity InstallFlags -> Flag Verbosity
installVerbosity (\Flag Verbosity
v InstallFlags
flags -> InstallFlags
flags{installVerbosity = v})
, (InstallFlags -> Flag FilePath)
-> (Flag FilePath -> InstallFlags -> InstallFlags)
-> ShowOrParseArgs
-> OptionField InstallFlags
forall flags.
(flags -> Flag FilePath)
-> (Flag FilePath -> flags -> flags)
-> ShowOrParseArgs
-> OptionField flags
optionDistPref
InstallFlags -> Flag FilePath
installDistPref
(\Flag FilePath
d InstallFlags
flags -> InstallFlags
flags{installDistPref = d})
ShowOrParseArgs
showOrParseArgs
, FilePath
-> [FilePath]
-> FilePath
-> (InstallFlags -> Flag Bool)
-> (Flag Bool -> InstallFlags -> InstallFlags)
-> MkOptDescr
(InstallFlags -> Flag Bool)
(Flag Bool -> InstallFlags -> InstallFlags)
InstallFlags
-> OptionField InstallFlags
forall get set a.
FilePath
-> [FilePath]
-> FilePath
-> get
-> set
-> MkOptDescr get set a
-> OptionField a
option
FilePath
""
[FilePath
"inplace"]
FilePath
"install the package in the install subdirectory of the dist prefix, so it can be used without being installed"
InstallFlags -> Flag Bool
installInPlace
(\Flag Bool
v InstallFlags
flags -> InstallFlags
flags{installInPlace = v})
MkOptDescr
(InstallFlags -> Flag Bool)
(Flag Bool -> InstallFlags -> InstallFlags)
InstallFlags
forall a. MkOptDescr (a -> Flag Bool) (Flag Bool -> a -> a) a
trueArg
, FilePath
-> [FilePath]
-> FilePath
-> (InstallFlags -> Flag Bool)
-> (Flag Bool -> InstallFlags -> InstallFlags)
-> MkOptDescr
(InstallFlags -> Flag Bool)
(Flag Bool -> InstallFlags -> InstallFlags)
InstallFlags
-> OptionField InstallFlags
forall get set a.
FilePath
-> [FilePath]
-> FilePath
-> get
-> set
-> MkOptDescr get set a
-> OptionField a
option
FilePath
""
[FilePath
"shell-wrappers"]
FilePath
"using shell script wrappers around executables"
InstallFlags -> Flag Bool
installUseWrapper
(\Flag Bool
v InstallFlags
flags -> InstallFlags
flags{installUseWrapper = v})
(FilePath
-> FilePath
-> MkOptDescr
(InstallFlags -> Flag Bool)
(Flag Bool -> InstallFlags -> InstallFlags)
InstallFlags
forall a.
FilePath
-> FilePath -> MkOptDescr (a -> Flag Bool) (Flag Bool -> a -> a) a
boolOpt [] [])
, FilePath
-> [FilePath]
-> FilePath
-> (InstallFlags -> Flag PackageDB)
-> (Flag PackageDB -> InstallFlags -> InstallFlags)
-> MkOptDescr
(InstallFlags -> Flag PackageDB)
(Flag PackageDB -> InstallFlags -> InstallFlags)
InstallFlags
-> OptionField InstallFlags
forall get set a.
FilePath
-> [FilePath]
-> FilePath
-> get
-> set
-> MkOptDescr get set a
-> OptionField a
option
FilePath
""
[FilePath
"package-db"]
FilePath
""
InstallFlags -> Flag PackageDB
installPackageDB
(\Flag PackageDB
v InstallFlags
flags -> InstallFlags
flags{installPackageDB = v})
( [(Flag PackageDB, OptFlags, FilePath)]
-> MkOptDescr
(InstallFlags -> Flag PackageDB)
(Flag PackageDB -> InstallFlags -> InstallFlags)
InstallFlags
forall b a.
Eq b =>
[(b, OptFlags, FilePath)] -> MkOptDescr (a -> b) (b -> a -> a) a
choiceOpt
[
( PackageDB -> Flag PackageDB
forall a. a -> Flag a
Flag PackageDB
UserPackageDB
, ([], [FilePath
"user"])
, FilePath
"upon configuration register this package in the user's local package database"
)
,
( PackageDB -> Flag PackageDB
forall a. a -> Flag a
Flag PackageDB
GlobalPackageDB
, ([], [FilePath
"global"])
, FilePath
"(default) upon configuration register this package in the system-wide package database"
)
]
)
, FilePath
-> [FilePath]
-> FilePath
-> (InstallFlags -> Flag CopyDest)
-> (Flag CopyDest -> InstallFlags -> InstallFlags)
-> MkOptDescr
(InstallFlags -> Flag CopyDest)
(Flag CopyDest -> InstallFlags -> InstallFlags)
InstallFlags
-> OptionField InstallFlags
forall get set a.
FilePath
-> [FilePath]
-> FilePath
-> get
-> set
-> MkOptDescr get set a
-> OptionField a
option
FilePath
""
[FilePath
"target-package-db"]
FilePath
"package database to install into. Required when using ${pkgroot} prefix."
InstallFlags -> Flag CopyDest
installDest
(\Flag CopyDest
v InstallFlags
flags -> InstallFlags
flags{installDest = v})
( FilePath
-> ReadE (Flag CopyDest)
-> (Flag CopyDest -> [FilePath])
-> MkOptDescr
(InstallFlags -> Flag CopyDest)
(Flag CopyDest -> InstallFlags -> InstallFlags)
InstallFlags
forall b a.
Monoid b =>
FilePath
-> ReadE b
-> (b -> [FilePath])
-> MkOptDescr (a -> b) (b -> a -> a) a
reqArg
FilePath
"DATABASE"
((FilePath -> Flag CopyDest) -> ReadE (Flag CopyDest)
forall a. (FilePath -> a) -> ReadE a
succeedReadE (CopyDest -> Flag CopyDest
forall a. a -> Flag a
Flag (CopyDest -> Flag CopyDest)
-> (FilePath -> CopyDest) -> FilePath -> Flag CopyDest
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> CopyDest
CopyToDb))
(\Flag CopyDest
f -> case Flag CopyDest
f of Flag (CopyToDb FilePath
p) -> [FilePath
p]; Flag CopyDest
_ -> [])
)
]
emptyInstallFlags :: InstallFlags
emptyInstallFlags :: InstallFlags
emptyInstallFlags = InstallFlags
forall a. Monoid a => a
mempty
instance Monoid InstallFlags where
mempty :: InstallFlags
mempty = InstallFlags
forall a. (Generic a, GMonoid (Rep a)) => a
gmempty
mappend :: InstallFlags -> InstallFlags -> InstallFlags
mappend = InstallFlags -> InstallFlags -> InstallFlags
forall a. Semigroup a => a -> a -> a
(<>)
instance Semigroup InstallFlags where
<> :: InstallFlags -> InstallFlags -> InstallFlags
(<>) = InstallFlags -> InstallFlags -> InstallFlags
forall a. (Generic a, GSemigroup (Rep a)) => a -> a -> a
gmappend