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

   1 {-# LANGUAGE CPP #-}
   2 {-# LANGUAGE DeriveDataTypeable #-}
   3 {-# LANGUAGE DeriveGeneric #-}
   4 {-# LANGUAGE FlexibleContexts #-}
   5 {-# LANGUAGE RankNTypes #-}
   6
   7 -----------------------------------------------------------------------------
   8
   9 -- |
  10 -- Module      :  Distribution.Simple.Setup.Register
  11 -- Copyright   :  Isaac Jones 2003-2004
  12 --                Duncan Coutts 2007
  13 -- License     :  BSD3
  14 --
  15 -- Maintainer  :  cabal-devel@haskell.org
  16 -- Portability :  portable
  17 --
  18 -- Definition of the register command-line options.
  19 -- See: @Distribution.Simple.Setup@
  20 module Distribution.Simple.Setup.Register
  21   ( RegisterFlags (..)
  22   , emptyRegisterFlags
  23   , defaultRegisterFlags
  24   , registerCommand
  25   , unregisterCommand
  26   ) where
  27
  28 import Distribution.Compat.Prelude hiding (get)
  29 import Prelude ()
  30
  31 import Distribution.Simple.Command hiding (boolOpt, boolOpt')
  32 import Distribution.Simple.Compiler
  33 import Distribution.Simple.Flag
  34 import Distribution.Verbosity
  35
  36 import Distribution.Simple.Setup.Common
  37
  38 -- ------------------------------------------------------------
  39
  40 -- * Register flags
  41
  42 -- ------------------------------------------------------------
  43
  44 -- | Flags to @register@ and @unregister@: (user package, gen-script,
  45 -- in-place, verbosity)
  46 data RegisterFlags = RegisterFlags
  47   { regPackageDB :: Flag PackageDB
  48   , regGenScript :: Flag Bool
  49   , regGenPkgConf :: Flag (Maybe FilePath)
  50   , regInPlace :: Flag Bool
  51   , regDistPref :: Flag FilePath
  52   , regPrintId :: Flag Bool
  53   , regVerbosity :: Flag Verbosity
  54   , -- Same as in 'buildArgs' and 'copyArgs'
  55     regArgs :: [String]
  56   , regCabalFilePath :: Flag FilePath
  57   }
  58   deriving (Show, Generic, Typeable)
  59
  60 defaultRegisterFlags :: RegisterFlags
  61 defaultRegisterFlags =
  62   RegisterFlags
  63     { regPackageDB = NoFlag
  64     , regGenScript = Flag False
  65     , regGenPkgConf = NoFlag
  66     , regInPlace = Flag False
  67     , regDistPref = NoFlag
  68     , regPrintId = Flag False
  69     , regArgs = []
  70     , regCabalFilePath = mempty
  71     , regVerbosity = Flag normal
  72     }
  73
  74 registerCommand :: CommandUI RegisterFlags
  75 registerCommand =
  76   CommandUI
  77     { commandName = "register"
  78     , commandSynopsis =
  79         "Register this package with the compiler."
  80     , commandDescription = Nothing
  81     , commandNotes = Nothing
  82     , commandUsage = \pname ->
  83         "Usage: " ++ pname ++ " register [FLAGS]\n"
  84     , commandDefaultFlags = defaultRegisterFlags
  85     , commandOptions = \showOrParseArgs ->
  86         [ optionVerbosity regVerbosity (\v flags -> flags{regVerbosity = v})
  87         , optionDistPref
  88             regDistPref
  89             (\d flags -> flags{regDistPref = d})
  90             showOrParseArgs
  91         , option
  92             ""
  93             ["packageDB"]
  94             ""
  95             regPackageDB
  96             (\v flags -> flags{regPackageDB = v})
  97             ( choiceOpt
  98                 [
  99                   ( Flag UserPackageDB
 100                   , ([], ["user"])
 101                   , "upon registration, register this package in the user's local package database"
 102                   )
 103                 ,
 104                   ( Flag GlobalPackageDB
 105                   , ([], ["global"])
 106                   , "(default)upon registration, register this package in the system-wide package database"
 107                   )
 108                 ]
 109             )
 110         , option
 111             ""
 112             ["inplace"]
 113             "register the package in the build location, so it can be used without being installed"
 114             regInPlace
 115             (\v flags -> flags{regInPlace = v})
 116             trueArg
 117         , option
 118             ""
 119             ["gen-script"]
 120             "instead of registering, generate a script to register later"
 121             regGenScript
 122             (\v flags -> flags{regGenScript = v})
 123             trueArg
 124         , option
 125             ""
 126             ["gen-pkg-config"]
 127             "instead of registering, generate a package registration file/directory"
 128             regGenPkgConf
 129             (\v flags -> flags{regGenPkgConf = v})
 130             (optArg' "PKG" Flag flagToList)
 131         , option
 132             ""
 133             ["print-ipid"]
 134             "print the installed package ID calculated for this package"
 135             regPrintId
 136             (\v flags -> flags{regPrintId = v})
 137             trueArg
 138         ]
 139     }
 140
 141 unregisterCommand :: CommandUI RegisterFlags
 142 unregisterCommand =
 143   CommandUI
 144     { commandName = "unregister"
 145     , commandSynopsis =
 146         "Unregister this package with the compiler."
 147     , commandDescription = Nothing
 148     , commandNotes = Nothing
 149     , commandUsage = \pname ->
 150         "Usage: " ++ pname ++ " unregister [FLAGS]\n"
 151     , commandDefaultFlags = defaultRegisterFlags
 152     , commandOptions = \showOrParseArgs ->
 153         [ optionVerbosity regVerbosity (\v flags -> flags{regVerbosity = v})
 154         , optionDistPref
 155             regDistPref
 156             (\d flags -> flags{regDistPref = d})
 157             showOrParseArgs
 158         , option
 159             ""
 160             ["user"]
 161             ""
 162             regPackageDB
 163             (\v flags -> flags{regPackageDB = v})
 164             ( choiceOpt
 165                 [
 166                   ( Flag UserPackageDB
 167                   , ([], ["user"])
 168                   , "unregister this package in the user's local package database"
 169                   )
 170                 ,
 171                   ( Flag GlobalPackageDB
 172                   , ([], ["global"])
 173                   , "(default) unregister this package in the  system-wide package database"
 174                   )
 175                 ]
 176             )
 177         , option
 178             ""
 179             ["gen-script"]
 180             "Instead of performing the unregister command, generate a script to unregister later"
 181             regGenScript
 182             (\v flags -> flags{regGenScript = v})
 183             trueArg
 184         ]
 185     }
 186
 187 emptyRegisterFlags :: RegisterFlags
 188 emptyRegisterFlags = mempty
 189
 190 instance Monoid RegisterFlags where
 191   mempty = gmempty
 192   mappend = (<>)
 193
 194 instance Semigroup RegisterFlags where
 195   (<>) = gmappend