Cabal/src/Distribution/Simple/Setup/Install.hs

   1 {-# LANGUAGE CPP #-}
   2 {-# LANGUAGE DataKinds #-}
   3 {-# LANGUAGE DeriveDataTypeable #-}
   4 {-# LANGUAGE DeriveGeneric #-}
   5 {-# LANGUAGE FlexibleContexts #-}
   6 {-# LANGUAGE PatternSynonyms #-}
   7 {-# LANGUAGE RankNTypes #-}
   8 {-# LANGUAGE ViewPatterns #-}
   9
  10 -----------------------------------------------------------------------------
  11
  12 -- |
  13 -- Module      :  Distribution.Simple.Setup.Install
  14 -- Copyright   :  Isaac Jones 2003-2004
  15 --                Duncan Coutts 2007
  16 -- License     :  BSD3
  17 --
  18 -- Maintainer  :  cabal-devel@haskell.org
  19 -- Portability :  portable
  20 --
  21 -- Definition of the install command-line options.
  22 -- See: @Distribution.Simple.Setup@
  23 module Distribution.Simple.Setup.Install
  24   ( InstallFlags
  25       ( InstallCommonFlags
  26       , installVerbosity
  27       , installDistPref
  28       , installCabalFilePath
  29       , installWorkingDir
  30       , installTargets
  31       , ..
  32       )
  33   , emptyInstallFlags
  34   , defaultInstallFlags
  35   , installCommand
  36   ) where
  37
  38 import Distribution.Compat.Prelude hiding (get)
  39 import Prelude ()
  40
  41 import Distribution.ReadE
  42 import Distribution.Simple.Command hiding (boolOpt, boolOpt')
  43 import Distribution.Simple.Compiler
  44 import Distribution.Simple.Flag
  45 import Distribution.Simple.InstallDirs
  46 import Distribution.Simple.Setup.Common
  47 import Distribution.Simple.Utils
  48 import Distribution.Utils.Path
  49 import Distribution.Verbosity
  50
  51 -- ------------------------------------------------------------
  52
  53 -- * Install flags
  54
  55 -- ------------------------------------------------------------
  56
  57 -- | Flags to @install@: (package db, verbosity)
  58 data InstallFlags = InstallFlags
  59   { installCommonFlags :: !CommonSetupFlags
  60   , installPackageDB :: Flag PackageDB
  61   , installDest :: Flag CopyDest
  62   , installUseWrapper :: Flag Bool
  63   , installInPlace :: Flag Bool
  64   }
  65   deriving (Show, Generic)
  66
  67 pattern InstallCommonFlags
  68   :: Flag Verbosity
  69   -> Flag (SymbolicPath Pkg (Dir Dist))
  70   -> Flag (SymbolicPath CWD (Dir Pkg))
  71   -> Flag (SymbolicPath Pkg File)
  72   -> [String]
  73   -> InstallFlags
  74 pattern InstallCommonFlags
  75   { installVerbosity
  76   , installDistPref
  77   , installWorkingDir
  78   , installCabalFilePath
  79   , installTargets
  80   } <-
  81   ( installCommonFlags ->
  82       CommonSetupFlags
  83         { setupVerbosity = installVerbosity
  84         , setupDistPref = installDistPref
  85         , setupWorkingDir = installWorkingDir
  86         , setupCabalFilePath = installCabalFilePath
  87         , setupTargets = installTargets
  88         }
  89     )
  90
  91 defaultInstallFlags :: InstallFlags
  92 defaultInstallFlags =
  93   InstallFlags
  94     { installCommonFlags = defaultCommonSetupFlags
  95     , installPackageDB = NoFlag
  96     , installDest = Flag NoCopyDest
  97     , installUseWrapper = Flag False
  98     , installInPlace = Flag False
  99     }
 100
 101 installCommand :: CommandUI InstallFlags
 102 installCommand =
 103   CommandUI
 104     { commandName = "install"
 105     , commandSynopsis =
 106         "Copy the files into the install locations. Run register."
 107     , commandDescription = Just $ \_ ->
 108         wrapText $
 109           "Unlike the copy command, install calls the register command. "
 110             ++ "If you want to install into a location that is not what was "
 111             ++ "specified in the configure step, use the copy command.\n"
 112     , commandNotes = Nothing
 113     , commandUsage = \pname ->
 114         "Usage: " ++ pname ++ " install [FLAGS]\n"
 115     , commandDefaultFlags = defaultInstallFlags
 116     , commandOptions = \showOrParseArgs ->
 117         withCommonSetupOptions
 118           installCommonFlags
 119           (\c f -> f{installCommonFlags = c})
 120           showOrParseArgs
 121           $ case showOrParseArgs of
 122             ShowArgs ->
 123               filter
 124                 ( (`notElem` ["target-package-db"])
 125                     . optionName
 126                 )
 127                 installOptions
 128             ParseArgs -> installOptions
 129     }
 130
 131 installOptions :: [OptionField InstallFlags]
 132 installOptions =
 133   [ option
 134       ""
 135       ["inplace"]
 136       "install the package in the install subdirectory of the dist prefix, so it can be used without being installed"
 137       installInPlace
 138       (\v flags -> flags{installInPlace = v})
 139       trueArg
 140   , option
 141       ""
 142       ["shell-wrappers"]
 143       "using shell script wrappers around executables"
 144       installUseWrapper
 145       (\v flags -> flags{installUseWrapper = v})
 146       (boolOpt [] [])
 147   , option
 148       ""
 149       ["package-db"]
 150       ""
 151       installPackageDB
 152       (\v flags -> flags{installPackageDB = v})
 153       ( choiceOpt
 154           [
 155             ( Flag UserPackageDB
 156             , ([], ["user"])
 157             , "upon configuration register this package in the user's local package database"
 158             )
 159           ,
 160             ( Flag GlobalPackageDB
 161             , ([], ["global"])
 162             , "(default) upon configuration register this package in the system-wide package database"
 163             )
 164           ]
 165       )
 166   , option
 167       ""
 168       ["target-package-db"]
 169       "package database to install into. Required when using ${pkgroot} prefix."
 170       installDest
 171       (\v flags -> flags{installDest = v})
 172       ( reqArg
 173           "DATABASE"
 174           (succeedReadE (Flag . CopyToDb))
 175           (\f -> case f of Flag (CopyToDb p) -> [p]; _ -> [])
 176       )
 177   ]
 178
 179 emptyInstallFlags :: InstallFlags
 180 emptyInstallFlags = mempty
 181
 182 instance Monoid InstallFlags where
 183   mempty = gmempty
 184   mappend = (<>)
 185
 186 instance Semigroup InstallFlags where
 187   (<>) = gmappend