{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE LambdaCase #-}
module Distribution.Client.CmdInstall.ClientInstallFlags
( InstallMethod(..)
, ClientInstallFlags(..)
, defaultClientInstallFlags
, clientInstallOptions
) where

import Distribution.Client.Compat.Prelude
import Prelude ()

import Distribution.ReadE
         ( succeedReadE, parsecToReadE )
import Distribution.Simple.Command
         ( ShowOrParseArgs(..), OptionField(..), option, reqArg )
import Distribution.Simple.Setup
         ( Flag(..), trueArg, flagToList, toFlag )

import Distribution.Client.Types.InstallMethod
         ( InstallMethod (..) )
import Distribution.Client.Types.OverwritePolicy
         ( OverwritePolicy(..) )

import qualified Distribution.Compat.CharParsing as P

data ClientInstallFlags = ClientInstallFlags
  { ClientInstallFlags -> Flag Bool
cinstInstallLibs     :: Flag Bool
  , ClientInstallFlags -> Flag FilePath
cinstEnvironmentPath :: Flag FilePath
  , ClientInstallFlags -> Flag OverwritePolicy
cinstOverwritePolicy :: Flag OverwritePolicy
  , ClientInstallFlags -> Flag InstallMethod
cinstInstallMethod   :: Flag InstallMethod
  , ClientInstallFlags -> Flag FilePath
cinstInstalldir      :: Flag FilePath
  } deriving (ClientInstallFlags -> ClientInstallFlags -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ClientInstallFlags -> ClientInstallFlags -> Bool
$c/= :: ClientInstallFlags -> ClientInstallFlags -> Bool
== :: ClientInstallFlags -> ClientInstallFlags -> Bool
$c== :: ClientInstallFlags -> ClientInstallFlags -> Bool
Eq, Int -> ClientInstallFlags -> ShowS
[ClientInstallFlags] -> ShowS
ClientInstallFlags -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [ClientInstallFlags] -> ShowS
$cshowList :: [ClientInstallFlags] -> ShowS
show :: ClientInstallFlags -> FilePath
$cshow :: ClientInstallFlags -> FilePath
showsPrec :: Int -> ClientInstallFlags -> ShowS
$cshowsPrec :: Int -> ClientInstallFlags -> ShowS
Show, forall x. Rep ClientInstallFlags x -> ClientInstallFlags
forall x. ClientInstallFlags -> Rep ClientInstallFlags x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ClientInstallFlags x -> ClientInstallFlags
$cfrom :: forall x. ClientInstallFlags -> Rep ClientInstallFlags x
Generic)

instance Monoid ClientInstallFlags where
  mempty :: ClientInstallFlags
mempty = forall a. (Generic a, GMonoid (Rep a)) => a
gmempty
  mappend :: ClientInstallFlags -> ClientInstallFlags -> ClientInstallFlags
mappend = forall a. Semigroup a => a -> a -> a
(<>)

instance Semigroup ClientInstallFlags where
  <> :: ClientInstallFlags -> ClientInstallFlags -> ClientInstallFlags
(<>) = forall a. (Generic a, GSemigroup (Rep a)) => a -> a -> a
gmappend

instance Binary ClientInstallFlags
instance Structured ClientInstallFlags

defaultClientInstallFlags :: ClientInstallFlags
defaultClientInstallFlags :: ClientInstallFlags
defaultClientInstallFlags = ClientInstallFlags
  { cinstInstallLibs :: Flag Bool
cinstInstallLibs     = forall a. a -> Flag a
toFlag Bool
False
  , cinstEnvironmentPath :: Flag FilePath
cinstEnvironmentPath = forall a. Monoid a => a
mempty
  , cinstOverwritePolicy :: Flag OverwritePolicy
cinstOverwritePolicy = forall a. Monoid a => a
mempty
  , cinstInstallMethod :: Flag InstallMethod
cinstInstallMethod   = forall a. Monoid a => a
mempty
  , cinstInstalldir :: Flag FilePath
cinstInstalldir      = forall a. Monoid a => a
mempty
  }

clientInstallOptions :: ShowOrParseArgs -> [OptionField ClientInstallFlags]
clientInstallOptions :: ShowOrParseArgs -> [OptionField ClientInstallFlags]
clientInstallOptions ShowOrParseArgs
_ =
  [ forall get set a.
FilePath
-> LFlags
-> FilePath
-> get
-> set
-> MkOptDescr get set a
-> OptionField a
option [] [FilePath
"lib"]
    ( FilePath
"Install libraries rather than executables from the target package " forall a. Semigroup a => a -> a -> a
<>
      FilePath
"(provisional, see https://github.com/haskell/cabal/issues/6481 for more information)." )
    ClientInstallFlags -> Flag Bool
cinstInstallLibs (\Flag Bool
v ClientInstallFlags
flags -> ClientInstallFlags
flags { cinstInstallLibs :: Flag Bool
cinstInstallLibs = Flag Bool
v })
    forall a. MkOptDescr (a -> Flag Bool) (Flag Bool -> a -> a) a
trueArg
  , forall get set a.
FilePath
-> LFlags
-> FilePath
-> get
-> set
-> MkOptDescr get set a
-> OptionField a
option [] [FilePath
"package-env", FilePath
"env"]
    FilePath
"Set the environment file that may be modified."
    ClientInstallFlags -> Flag FilePath
cinstEnvironmentPath (\Flag FilePath
pf ClientInstallFlags
flags -> ClientInstallFlags
flags { cinstEnvironmentPath :: Flag FilePath
cinstEnvironmentPath = Flag FilePath
pf })
    (forall b a.
Monoid b =>
FilePath
-> ReadE b -> (b -> LFlags) -> MkOptDescr (a -> b) (b -> a -> a) a
reqArg FilePath
"ENV" (forall a. (FilePath -> a) -> ReadE a
succeedReadE forall a. a -> Flag a
Flag) forall a. Flag a -> [a]
flagToList)
  , forall get set a.
FilePath
-> LFlags
-> FilePath
-> get
-> set
-> MkOptDescr get set a
-> OptionField a
option [] [FilePath
"overwrite-policy"]
    FilePath
"How to handle already existing symlinks."
    ClientInstallFlags -> Flag OverwritePolicy
cinstOverwritePolicy (\Flag OverwritePolicy
v ClientInstallFlags
flags -> ClientInstallFlags
flags { cinstOverwritePolicy :: Flag OverwritePolicy
cinstOverwritePolicy = Flag OverwritePolicy
v })
    forall a b. (a -> b) -> a -> b
$ forall b a.
Monoid b =>
FilePath
-> ReadE b -> (b -> LFlags) -> MkOptDescr (a -> b) (b -> a -> a) a
reqArg FilePath
"always|never|prompt"
        (forall a. ShowS -> ParsecParser a -> ReadE a
parsecToReadE (\FilePath
err -> FilePath
"Error parsing overwrite-policy: " forall a. [a] -> [a] -> [a]
++ FilePath
err) (forall a. a -> Flag a
toFlag forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
parsec))
        (forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> FilePath
prettyShow forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Flag a -> [a]
flagToList)
  , forall get set a.
FilePath
-> LFlags
-> FilePath
-> get
-> set
-> MkOptDescr get set a
-> OptionField a
option [] [FilePath
"install-method"]
    FilePath
"How to install the executables."
    ClientInstallFlags -> Flag InstallMethod
cinstInstallMethod (\Flag InstallMethod
v ClientInstallFlags
flags -> ClientInstallFlags
flags { cinstInstallMethod :: Flag InstallMethod
cinstInstallMethod = Flag InstallMethod
v })
    forall a b. (a -> b) -> a -> b
$ forall b a.
Monoid b =>
FilePath
-> ReadE b -> (b -> LFlags) -> MkOptDescr (a -> b) (b -> a -> a) a
reqArg
        FilePath
"default|copy|symlink"
        (forall a. ShowS -> ParsecParser a -> ReadE a
parsecToReadE (\FilePath
err -> FilePath
"Error parsing install-method: " forall a. [a] -> [a] -> [a]
++ FilePath
err) (forall a. a -> Flag a
toFlag forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` forall (m :: * -> *). CabalParsing m => m InstallMethod
parsecInstallMethod))
        (forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> FilePath
prettyShow forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Flag a -> [a]
flagToList)
  , forall get set a.
FilePath
-> LFlags
-> FilePath
-> get
-> set
-> MkOptDescr get set a
-> OptionField a
option [] [FilePath
"installdir"]
    FilePath
"Where to install (by symlinking or copying) the executables in."
    ClientInstallFlags -> Flag FilePath
cinstInstalldir (\Flag FilePath
v ClientInstallFlags
flags -> ClientInstallFlags
flags { cinstInstalldir :: Flag FilePath
cinstInstalldir = Flag FilePath
v })
    forall a b. (a -> b) -> a -> b
$ forall b a.
Monoid b =>
FilePath
-> ReadE b -> (b -> LFlags) -> MkOptDescr (a -> b) (b -> a -> a) a
reqArg FilePath
"DIR" (forall a. (FilePath -> a) -> ReadE a
succeedReadE forall a. a -> Flag a
Flag) forall a. Flag a -> [a]
flagToList
  ]

parsecInstallMethod :: CabalParsing m => m InstallMethod
parsecInstallMethod :: forall (m :: * -> *). CabalParsing m => m InstallMethod
parsecInstallMethod = do
    FilePath
name <- forall (m :: * -> *). CharParsing m => (Char -> Bool) -> m FilePath
P.munch1 Char -> Bool
isAlpha
    case FilePath
name of
        FilePath
"copy"    -> forall (f :: * -> *) a. Applicative f => a -> f a
pure InstallMethod
InstallMethodCopy
        FilePath
"symlink" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure InstallMethod
InstallMethodSymlink
        FilePath
_         -> forall (m :: * -> *) a. Parsing m => FilePath -> m a
P.unexpected forall a b. (a -> b) -> a -> b
$ FilePath
"InstallMethod: " forall a. [a] -> [a] -> [a]
++ FilePath
name