{-# 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
(ClientInstallFlags -> ClientInstallFlags -> Bool)
-> (ClientInstallFlags -> ClientInstallFlags -> Bool)
-> Eq ClientInstallFlags
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
(Int -> ClientInstallFlags -> ShowS)
-> (ClientInstallFlags -> FilePath)
-> ([ClientInstallFlags] -> ShowS)
-> Show ClientInstallFlags
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. ClientInstallFlags -> Rep ClientInstallFlags x)
-> (forall x. Rep ClientInstallFlags x -> ClientInstallFlags)
-> Generic ClientInstallFlags
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 = ClientInstallFlags
forall a. (Generic a, GMonoid (Rep a)) => a
gmempty
  mappend :: ClientInstallFlags -> ClientInstallFlags -> ClientInstallFlags
mappend = ClientInstallFlags -> ClientInstallFlags -> ClientInstallFlags
forall a. Semigroup a => a -> a -> a
(<>)

instance Semigroup ClientInstallFlags where
  <> :: ClientInstallFlags -> ClientInstallFlags -> ClientInstallFlags
(<>) = 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 :: Flag Bool
-> Flag FilePath
-> Flag OverwritePolicy
-> Flag InstallMethod
-> Flag FilePath
-> ClientInstallFlags
ClientInstallFlags
  { cinstInstallLibs :: Flag Bool
cinstInstallLibs     = Bool -> Flag Bool
forall a. a -> Flag a
toFlag Bool
False
  , cinstEnvironmentPath :: Flag FilePath
cinstEnvironmentPath = Flag FilePath
forall a. Monoid a => a
mempty
  , cinstOverwritePolicy :: Flag OverwritePolicy
cinstOverwritePolicy = Flag OverwritePolicy
forall a. Monoid a => a
mempty
  , cinstInstallMethod :: Flag InstallMethod
cinstInstallMethod   = Flag InstallMethod
forall a. Monoid a => a
mempty
  , cinstInstalldir :: Flag FilePath
cinstInstalldir      = Flag FilePath
forall a. Monoid a => a
mempty
  }

clientInstallOptions :: ShowOrParseArgs -> [OptionField ClientInstallFlags]
clientInstallOptions :: ShowOrParseArgs -> [OptionField ClientInstallFlags]
clientInstallOptions ShowOrParseArgs
_ =
  [ FilePath
-> LFlags
-> FilePath
-> (ClientInstallFlags -> Flag Bool)
-> (Flag Bool -> ClientInstallFlags -> ClientInstallFlags)
-> MkOptDescr
     (ClientInstallFlags -> Flag Bool)
     (Flag Bool -> ClientInstallFlags -> ClientInstallFlags)
     ClientInstallFlags
-> OptionField ClientInstallFlags
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 " FilePath -> ShowS
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 })
    MkOptDescr
  (ClientInstallFlags -> Flag Bool)
  (Flag Bool -> ClientInstallFlags -> ClientInstallFlags)
  ClientInstallFlags
forall a. MkOptDescr (a -> Flag Bool) (Flag Bool -> a -> a) a
trueArg
  , FilePath
-> LFlags
-> FilePath
-> (ClientInstallFlags -> Flag FilePath)
-> (Flag FilePath -> ClientInstallFlags -> ClientInstallFlags)
-> MkOptDescr
     (ClientInstallFlags -> Flag FilePath)
     (Flag FilePath -> ClientInstallFlags -> ClientInstallFlags)
     ClientInstallFlags
-> OptionField ClientInstallFlags
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 })
    (FilePath
-> ReadE (Flag FilePath)
-> (Flag FilePath -> LFlags)
-> MkOptDescr
     (ClientInstallFlags -> Flag FilePath)
     (Flag FilePath -> ClientInstallFlags -> ClientInstallFlags)
     ClientInstallFlags
forall b a.
Monoid b =>
FilePath
-> ReadE b -> (b -> LFlags) -> MkOptDescr (a -> b) (b -> a -> a) a
reqArg FilePath
"ENV" ((FilePath -> Flag FilePath) -> ReadE (Flag FilePath)
forall a. (FilePath -> a) -> ReadE a
succeedReadE FilePath -> Flag FilePath
forall a. a -> Flag a
Flag) Flag FilePath -> LFlags
forall a. Flag a -> [a]
flagToList)
  , FilePath
-> LFlags
-> FilePath
-> (ClientInstallFlags -> Flag OverwritePolicy)
-> (Flag OverwritePolicy
    -> ClientInstallFlags -> ClientInstallFlags)
-> MkOptDescr
     (ClientInstallFlags -> Flag OverwritePolicy)
     (Flag OverwritePolicy -> ClientInstallFlags -> ClientInstallFlags)
     ClientInstallFlags
-> OptionField ClientInstallFlags
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 })
    (MkOptDescr
   (ClientInstallFlags -> Flag OverwritePolicy)
   (Flag OverwritePolicy -> ClientInstallFlags -> ClientInstallFlags)
   ClientInstallFlags
 -> OptionField ClientInstallFlags)
-> MkOptDescr
     (ClientInstallFlags -> Flag OverwritePolicy)
     (Flag OverwritePolicy -> ClientInstallFlags -> ClientInstallFlags)
     ClientInstallFlags
-> OptionField ClientInstallFlags
forall a b. (a -> b) -> a -> b
$ FilePath
-> ReadE (Flag OverwritePolicy)
-> (Flag OverwritePolicy -> LFlags)
-> MkOptDescr
     (ClientInstallFlags -> Flag OverwritePolicy)
     (Flag OverwritePolicy -> ClientInstallFlags -> ClientInstallFlags)
     ClientInstallFlags
forall b a.
Monoid b =>
FilePath
-> ReadE b -> (b -> LFlags) -> MkOptDescr (a -> b) (b -> a -> a) a
reqArg FilePath
"always|never|prompt"
        (ShowS
-> ParsecParser (Flag OverwritePolicy)
-> ReadE (Flag OverwritePolicy)
forall a. ShowS -> ParsecParser a -> ReadE a
parsecToReadE (\FilePath
err -> FilePath
"Error parsing overwrite-policy: " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
err) (OverwritePolicy -> Flag OverwritePolicy
forall a. a -> Flag a
toFlag (OverwritePolicy -> Flag OverwritePolicy)
-> ParsecParser OverwritePolicy
-> ParsecParser (Flag OverwritePolicy)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` ParsecParser OverwritePolicy
forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
parsec)) 
        ((OverwritePolicy -> FilePath) -> [OverwritePolicy] -> LFlags
forall a b. (a -> b) -> [a] -> [b]
map OverwritePolicy -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow ([OverwritePolicy] -> LFlags)
-> (Flag OverwritePolicy -> [OverwritePolicy])
-> Flag OverwritePolicy
-> LFlags
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Flag OverwritePolicy -> [OverwritePolicy]
forall a. Flag a -> [a]
flagToList)
  , FilePath
-> LFlags
-> FilePath
-> (ClientInstallFlags -> Flag InstallMethod)
-> (Flag InstallMethod -> ClientInstallFlags -> ClientInstallFlags)
-> MkOptDescr
     (ClientInstallFlags -> Flag InstallMethod)
     (Flag InstallMethod -> ClientInstallFlags -> ClientInstallFlags)
     ClientInstallFlags
-> OptionField ClientInstallFlags
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 })
    (MkOptDescr
   (ClientInstallFlags -> Flag InstallMethod)
   (Flag InstallMethod -> ClientInstallFlags -> ClientInstallFlags)
   ClientInstallFlags
 -> OptionField ClientInstallFlags)
-> MkOptDescr
     (ClientInstallFlags -> Flag InstallMethod)
     (Flag InstallMethod -> ClientInstallFlags -> ClientInstallFlags)
     ClientInstallFlags
-> OptionField ClientInstallFlags
forall a b. (a -> b) -> a -> b
$ FilePath
-> ReadE (Flag InstallMethod)
-> (Flag InstallMethod -> LFlags)
-> MkOptDescr
     (ClientInstallFlags -> Flag InstallMethod)
     (Flag InstallMethod -> ClientInstallFlags -> ClientInstallFlags)
     ClientInstallFlags
forall b a.
Monoid b =>
FilePath
-> ReadE b -> (b -> LFlags) -> MkOptDescr (a -> b) (b -> a -> a) a
reqArg
        FilePath
"default|copy|symlink"
        (ShowS
-> ParsecParser (Flag InstallMethod) -> ReadE (Flag InstallMethod)
forall a. ShowS -> ParsecParser a -> ReadE a
parsecToReadE (\FilePath
err -> FilePath
"Error parsing install-method: " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
err) (InstallMethod -> Flag InstallMethod
forall a. a -> Flag a
toFlag (InstallMethod -> Flag InstallMethod)
-> ParsecParser InstallMethod -> ParsecParser (Flag InstallMethod)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` ParsecParser InstallMethod
forall (m :: * -> *). CabalParsing m => m InstallMethod
parsecInstallMethod))
        ((InstallMethod -> FilePath) -> [InstallMethod] -> LFlags
forall a b. (a -> b) -> [a] -> [b]
map InstallMethod -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow ([InstallMethod] -> LFlags)
-> (Flag InstallMethod -> [InstallMethod])
-> Flag InstallMethod
-> LFlags
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Flag InstallMethod -> [InstallMethod]
forall a. Flag a -> [a]
flagToList)
  , FilePath
-> LFlags
-> FilePath
-> (ClientInstallFlags -> Flag FilePath)
-> (Flag FilePath -> ClientInstallFlags -> ClientInstallFlags)
-> MkOptDescr
     (ClientInstallFlags -> Flag FilePath)
     (Flag FilePath -> ClientInstallFlags -> ClientInstallFlags)
     ClientInstallFlags
-> OptionField ClientInstallFlags
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 })
    (MkOptDescr
   (ClientInstallFlags -> Flag FilePath)
   (Flag FilePath -> ClientInstallFlags -> ClientInstallFlags)
   ClientInstallFlags
 -> OptionField ClientInstallFlags)
-> MkOptDescr
     (ClientInstallFlags -> Flag FilePath)
     (Flag FilePath -> ClientInstallFlags -> ClientInstallFlags)
     ClientInstallFlags
-> OptionField ClientInstallFlags
forall a b. (a -> b) -> a -> b
$ FilePath
-> ReadE (Flag FilePath)
-> (Flag FilePath -> LFlags)
-> MkOptDescr
     (ClientInstallFlags -> Flag FilePath)
     (Flag FilePath -> ClientInstallFlags -> ClientInstallFlags)
     ClientInstallFlags
forall b a.
Monoid b =>
FilePath
-> ReadE b -> (b -> LFlags) -> MkOptDescr (a -> b) (b -> a -> a) a
reqArg FilePath
"DIR" ((FilePath -> Flag FilePath) -> ReadE (Flag FilePath)
forall a. (FilePath -> a) -> ReadE a
succeedReadE FilePath -> Flag FilePath
forall a. a -> Flag a
Flag) Flag FilePath -> LFlags
forall a. Flag a -> [a]
flagToList
  ]

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