never executed always true always false

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