Cabal/src/Distribution/Simple/Setup/Register.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.Register
  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 register command-line options.
  22 -- See: @Distribution.Simple.Setup@
  23 module Distribution.Simple.Setup.Register
  24   ( RegisterFlags
  25       ( RegisterCommonFlags
  26       , registerVerbosity
  27       , registerDistPref
  28       , registerCabalFilePath
  29       , registerWorkingDir
  30       , registerTargets
  31       , ..
  32       )
  33   , emptyRegisterFlags
  34   , defaultRegisterFlags
  35   , registerCommand
  36   , unregisterCommand
  37   ) where
  38
  39 import Distribution.Compat.Prelude hiding (get)
  40 import Prelude ()
  41
  42 import Distribution.Simple.Command hiding (boolOpt, boolOpt')
  43 import Distribution.Simple.Compiler
  44 import Distribution.Simple.Flag
  45 import Distribution.Simple.Setup.Common
  46 import Distribution.Utils.Path
  47 import Distribution.Verbosity
  48
  49 -- ------------------------------------------------------------
  50
  51 -- * Register flags
  52
  53 -- ------------------------------------------------------------
  54
  55 -- | Flags to @register@ and @unregister@: (user package, gen-script,
  56 -- in-place, verbosity)
  57 data RegisterFlags = RegisterFlags
  58   { registerCommonFlags :: !CommonSetupFlags
  59   , regPackageDB :: Flag PackageDB
  60   , regGenScript :: Flag Bool
  61   , regGenPkgConf :: Flag (Maybe (SymbolicPath Pkg (Dir PkgConf)))
  62   , regInPlace :: Flag Bool
  63   , regPrintId :: Flag Bool
  64   }
  65   deriving (Show, Generic, Typeable)
  66
  67 pattern RegisterCommonFlags
  68   :: Flag Verbosity
  69   -> Flag (SymbolicPath Pkg (Dir Dist))
  70   -> Flag (SymbolicPath CWD (Dir Pkg))
  71   -> Flag (SymbolicPath Pkg File)
  72   -> [String]
  73   -> RegisterFlags
  74 pattern RegisterCommonFlags
  75   { registerVerbosity
  76   , registerDistPref
  77   , registerWorkingDir
  78   , registerCabalFilePath
  79   , registerTargets
  80   } <-
  81   ( registerCommonFlags ->
  82       CommonSetupFlags
  83         { setupVerbosity = registerVerbosity
  84         , setupDistPref = registerDistPref
  85         , setupWorkingDir = registerWorkingDir
  86         , setupCabalFilePath = registerCabalFilePath
  87         , setupTargets = registerTargets
  88         }
  89     )
  90
  91 defaultRegisterFlags :: RegisterFlags
  92 defaultRegisterFlags =
  93   RegisterFlags
  94     { registerCommonFlags = defaultCommonSetupFlags
  95     , regPackageDB = NoFlag
  96     , regGenScript = Flag False
  97     , regGenPkgConf = NoFlag
  98     , regInPlace = Flag False
  99     , regPrintId = Flag False
 100     }
 101
 102 registerCommand :: CommandUI RegisterFlags
 103 registerCommand =
 104   CommandUI
 105     { commandName = "register"
 106     , commandSynopsis =
 107         "Register this package with the compiler."
 108     , commandDescription = Nothing
 109     , commandNotes = Nothing
 110     , commandUsage = \pname ->
 111         "Usage: " ++ pname ++ " register [FLAGS]\n"
 112     , commandDefaultFlags = defaultRegisterFlags
 113     , commandOptions = \showOrParseArgs ->
 114         withCommonSetupOptions
 115           registerCommonFlags
 116           (\c f -> f{registerCommonFlags = c})
 117           showOrParseArgs
 118           $ [ option
 119                 ""
 120                 ["packageDB"]
 121                 ""
 122                 regPackageDB
 123                 (\v flags -> flags{regPackageDB = v})
 124                 ( choiceOpt
 125                     [
 126                       ( Flag UserPackageDB
 127                       , ([], ["user"])
 128                       , "upon registration, register this package in the user's local package database"
 129                       )
 130                     ,
 131                       ( Flag GlobalPackageDB
 132                       , ([], ["global"])
 133                       , "(default)upon registration, register this package in the system-wide package database"
 134                       )
 135                     ]
 136                 )
 137             , option
 138                 ""
 139                 ["inplace"]
 140                 "register the package in the build location, so it can be used without being installed"
 141                 regInPlace
 142                 (\v flags -> flags{regInPlace = v})
 143                 trueArg
 144             , option
 145                 ""
 146                 ["gen-script"]
 147                 "instead of registering, generate a script to register later"
 148                 regGenScript
 149                 (\v flags -> flags{regGenScript = v})
 150                 trueArg
 151             , option
 152                 ""
 153                 ["gen-pkg-config"]
 154                 "instead of registering, generate a package registration file/directory"
 155                 regGenPkgConf
 156                 (\v flags -> flags{regGenPkgConf = v})
 157                 (optArg' "PKG" (Flag . fmap makeSymbolicPath) (flagToList . fmap (fmap getSymbolicPath)))
 158             , option
 159                 ""
 160                 ["print-ipid"]
 161                 "print the installed package ID calculated for this package"
 162                 regPrintId
 163                 (\v flags -> flags{regPrintId = v})
 164                 trueArg
 165             ]
 166     }
 167
 168 unregisterCommand :: CommandUI RegisterFlags
 169 unregisterCommand =
 170   CommandUI
 171     { commandName = "unregister"
 172     , commandSynopsis =
 173         "Unregister this package with the compiler."
 174     , commandDescription = Nothing
 175     , commandNotes = Nothing
 176     , commandUsage = \pname ->
 177         "Usage: " ++ pname ++ " unregister [FLAGS]\n"
 178     , commandDefaultFlags = defaultRegisterFlags
 179     , commandOptions = \showOrParseArgs ->
 180         withCommonSetupOptions
 181           registerCommonFlags
 182           (\c f -> f{registerCommonFlags = c})
 183           showOrParseArgs
 184           $ [ option
 185                 ""
 186                 ["user"]
 187                 ""
 188                 regPackageDB
 189                 (\v flags -> flags{regPackageDB = v})
 190                 ( choiceOpt
 191                     [
 192                       ( Flag UserPackageDB
 193                       , ([], ["user"])
 194                       , "unregister this package in the user's local package database"
 195                       )
 196                     ,
 197                       ( Flag GlobalPackageDB
 198                       , ([], ["global"])
 199                       , "(default) unregister this package in the  system-wide package database"
 200                       )
 201                     ]
 202                 )
 203             , option
 204                 ""
 205                 ["gen-script"]
 206                 "Instead of performing the unregister command, generate a script to unregister later"
 207                 regGenScript
 208                 (\v flags -> flags{regGenScript = v})
 209                 trueArg
 210             ]
 211     }
 212
 213 emptyRegisterFlags :: RegisterFlags
 214 emptyRegisterFlags = mempty
 215
 216 instance Monoid RegisterFlags where
 217   mempty = gmempty
 218   mappend = (<>)
 219
 220 instance Semigroup RegisterFlags where
 221   (<>) = gmappend