1{-# LANGUAGE DeriveGeneric #-}
2{-# LANGUAGE LambdaCase #-}
3module Distribution.Client.CmdInstall.ClientInstallFlags
4( InstallMethod(..)
5, ClientInstallFlags(..)
6, defaultClientInstallFlags
7, clientInstallOptions
8) where
9
10import Distribution.Client.Compat.Prelude
11import Prelude ()
12
13import Distribution.ReadE
14         ( succeedReadE, parsecToReadE )
15import Distribution.Simple.Command
16         ( ShowOrParseArgs(..), OptionField(..), option, reqArg )
17import Distribution.Simple.Setup
18         ( Flag(..), trueArg, flagToList, toFlag )
19
20import Distribution.Client.Types.InstallMethod
21         ( InstallMethod (..) )
22import Distribution.Client.Types.OverwritePolicy
23         ( OverwritePolicy(..) )
24
25import qualified Distribution.Compat.CharParsing as P
26
27data ClientInstallFlags = ClientInstallFlags
28  { cinstInstallLibs     :: Flag Bool
29  , cinstEnvironmentPath :: Flag FilePath
30  , cinstOverwritePolicy :: Flag OverwritePolicy
31  , cinstInstallMethod   :: Flag InstallMethod
32  , cinstInstalldir      :: Flag FilePath
33  } deriving (Eq, Show, Generic)
34
35instance Monoid ClientInstallFlags where
36  mempty = gmempty
37  mappend = (<>)
38
39instance Semigroup ClientInstallFlags where
40  (<>) = gmappend
41
42instance Binary ClientInstallFlags
43instance Structured ClientInstallFlags
44
45defaultClientInstallFlags :: ClientInstallFlags
46defaultClientInstallFlags = ClientInstallFlags
47  { cinstInstallLibs     = toFlag False
48  , cinstEnvironmentPath = mempty
49  , cinstOverwritePolicy = mempty
50  , cinstInstallMethod   = mempty
51  , cinstInstalldir      = mempty
52  }
53
54clientInstallOptions :: ShowOrParseArgs -> [OptionField ClientInstallFlags]
55clientInstallOptions _ =
56  [ option [] ["lib"]
57    "Install libraries rather than executables from the target package."
58    cinstInstallLibs (\v flags -> flags { cinstInstallLibs = v })
59    trueArg
60  , option [] ["package-env", "env"]
61    "Set the environment file that may be modified."
62    cinstEnvironmentPath (\pf flags -> flags { cinstEnvironmentPath = pf })
63    (reqArg "ENV" (succeedReadE Flag) flagToList)
64  , option [] ["overwrite-policy"]
65    "How to handle already existing symlinks."
66    cinstOverwritePolicy (\v flags -> flags { cinstOverwritePolicy = v })
67    $ reqArg "always|never"
68        (parsecToReadE (\err -> "Error parsing overwrite-policy: " ++ err) (toFlag `fmap` parsec))
69        (map prettyShow . flagToList)
70  , option [] ["install-method"]
71    "How to install the executables."
72    cinstInstallMethod (\v flags -> flags { cinstInstallMethod = v })
73    $ reqArg
74        "default|copy|symlink"
75        (parsecToReadE (\err -> "Error parsing install-method: " ++ err) (toFlag `fmap` parsecInstallMethod))
76        (map prettyShow . flagToList)
77  , option [] ["installdir"]
78    "Where to install (by symlinking or copying) the executables in."
79    cinstInstalldir (\v flags -> flags { cinstInstalldir = v })
80    $ reqArg "DIR" (succeedReadE Flag) flagToList
81  ]
82
83parsecInstallMethod :: CabalParsing m => m InstallMethod
84parsecInstallMethod = do
85    name <- P.munch1 isAlpha
86    case name of
87        "copy"    -> pure InstallMethodCopy
88        "symlink" -> pure InstallMethodSymlink
89        _         -> P.unexpected $ "InstallMethod: " ++ name
90