{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RankNTypes #-}

-----------------------------------------------------------------------------

-- |
-- Module      :  Distribution.Simple.Setup.Register
-- Copyright   :  Isaac Jones 2003-2004
--                Duncan Coutts 2007
-- License     :  BSD3
--
-- Maintainer  :  cabal-devel@haskell.org
-- Portability :  portable
--
-- Definition of the register command-line options.
-- See: @Distribution.Simple.Setup@
module Distribution.Simple.Setup.Register
  ( RegisterFlags (..)
  , emptyRegisterFlags
  , defaultRegisterFlags
  , registerCommand
  , unregisterCommand
  ) where

import Distribution.Compat.Prelude hiding (get)
import Prelude ()

import Distribution.Simple.Command hiding (boolOpt, boolOpt')
import Distribution.Simple.Compiler
import Distribution.Simple.Flag
import Distribution.Verbosity

import Distribution.Simple.Setup.Common

-- ------------------------------------------------------------

-- * Register flags

-- ------------------------------------------------------------

-- | Flags to @register@ and @unregister@: (user package, gen-script,
-- in-place, verbosity)
data RegisterFlags = RegisterFlags
  { RegisterFlags -> Flag PackageDB
regPackageDB :: Flag PackageDB
  , RegisterFlags -> Flag Bool
regGenScript :: Flag Bool
  , RegisterFlags -> Flag (Maybe FilePath)
regGenPkgConf :: Flag (Maybe FilePath)
  , RegisterFlags -> Flag Bool
regInPlace :: Flag Bool
  , RegisterFlags -> Flag FilePath
regDistPref :: Flag FilePath
  , RegisterFlags -> Flag Bool
regPrintId :: Flag Bool
  , RegisterFlags -> Flag Verbosity
regVerbosity :: Flag Verbosity
  , -- Same as in 'buildArgs' and 'copyArgs'
    RegisterFlags -> [FilePath]
regArgs :: [String]
  , RegisterFlags -> Flag FilePath
regCabalFilePath :: Flag FilePath
  }
  deriving (Int -> RegisterFlags -> ShowS
[RegisterFlags] -> ShowS
RegisterFlags -> FilePath
(Int -> RegisterFlags -> ShowS)
-> (RegisterFlags -> FilePath)
-> ([RegisterFlags] -> ShowS)
-> Show RegisterFlags
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RegisterFlags -> ShowS
showsPrec :: Int -> RegisterFlags -> ShowS
$cshow :: RegisterFlags -> FilePath
show :: RegisterFlags -> FilePath
$cshowList :: [RegisterFlags] -> ShowS
showList :: [RegisterFlags] -> ShowS
Show, (forall x. RegisterFlags -> Rep RegisterFlags x)
-> (forall x. Rep RegisterFlags x -> RegisterFlags)
-> Generic RegisterFlags
forall x. Rep RegisterFlags x -> RegisterFlags
forall x. RegisterFlags -> Rep RegisterFlags x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. RegisterFlags -> Rep RegisterFlags x
from :: forall x. RegisterFlags -> Rep RegisterFlags x
$cto :: forall x. Rep RegisterFlags x -> RegisterFlags
to :: forall x. Rep RegisterFlags x -> RegisterFlags
Generic, Typeable)

defaultRegisterFlags :: RegisterFlags
defaultRegisterFlags :: RegisterFlags
defaultRegisterFlags =
  RegisterFlags
    { regPackageDB :: Flag PackageDB
regPackageDB = Flag PackageDB
forall a. Flag a
NoFlag
    , regGenScript :: Flag Bool
regGenScript = Bool -> Flag Bool
forall a. a -> Flag a
Flag Bool
False
    , regGenPkgConf :: Flag (Maybe FilePath)
regGenPkgConf = Flag (Maybe FilePath)
forall a. Flag a
NoFlag
    , regInPlace :: Flag Bool
regInPlace = Bool -> Flag Bool
forall a. a -> Flag a
Flag Bool
False
    , regDistPref :: Flag FilePath
regDistPref = Flag FilePath
forall a. Flag a
NoFlag
    , regPrintId :: Flag Bool
regPrintId = Bool -> Flag Bool
forall a. a -> Flag a
Flag Bool
False
    , regArgs :: [FilePath]
regArgs = []
    , regCabalFilePath :: Flag FilePath
regCabalFilePath = Flag FilePath
forall a. Monoid a => a
mempty
    , regVerbosity :: Flag Verbosity
regVerbosity = Verbosity -> Flag Verbosity
forall a. a -> Flag a
Flag Verbosity
normal
    }

registerCommand :: CommandUI RegisterFlags
registerCommand :: CommandUI RegisterFlags
registerCommand =
  CommandUI
    { commandName :: FilePath
commandName = FilePath
"register"
    , commandSynopsis :: FilePath
commandSynopsis =
        FilePath
"Register this package with the compiler."
    , commandDescription :: Maybe ShowS
commandDescription = Maybe ShowS
forall a. Maybe a
Nothing
    , commandNotes :: Maybe ShowS
commandNotes = Maybe ShowS
forall a. Maybe a
Nothing
    , commandUsage :: ShowS
commandUsage = \FilePath
pname ->
        FilePath
"Usage: " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
pname FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
" register [FLAGS]\n"
    , commandDefaultFlags :: RegisterFlags
commandDefaultFlags = RegisterFlags
defaultRegisterFlags
    , commandOptions :: ShowOrParseArgs -> [OptionField RegisterFlags]
commandOptions = \ShowOrParseArgs
showOrParseArgs ->
        [ (RegisterFlags -> Flag Verbosity)
-> (Flag Verbosity -> RegisterFlags -> RegisterFlags)
-> OptionField RegisterFlags
forall flags.
(flags -> Flag Verbosity)
-> (Flag Verbosity -> flags -> flags) -> OptionField flags
optionVerbosity RegisterFlags -> Flag Verbosity
regVerbosity (\Flag Verbosity
v RegisterFlags
flags -> RegisterFlags
flags{regVerbosity = v})
        , (RegisterFlags -> Flag FilePath)
-> (Flag FilePath -> RegisterFlags -> RegisterFlags)
-> ShowOrParseArgs
-> OptionField RegisterFlags
forall flags.
(flags -> Flag FilePath)
-> (Flag FilePath -> flags -> flags)
-> ShowOrParseArgs
-> OptionField flags
optionDistPref
            RegisterFlags -> Flag FilePath
regDistPref
            (\Flag FilePath
d RegisterFlags
flags -> RegisterFlags
flags{regDistPref = d})
            ShowOrParseArgs
showOrParseArgs
        , FilePath
-> [FilePath]
-> FilePath
-> (RegisterFlags -> Flag PackageDB)
-> (Flag PackageDB -> RegisterFlags -> RegisterFlags)
-> MkOptDescr
     (RegisterFlags -> Flag PackageDB)
     (Flag PackageDB -> RegisterFlags -> RegisterFlags)
     RegisterFlags
-> OptionField RegisterFlags
forall get set a.
FilePath
-> [FilePath]
-> FilePath
-> get
-> set
-> MkOptDescr get set a
-> OptionField a
option
            FilePath
""
            [FilePath
"packageDB"]
            FilePath
""
            RegisterFlags -> Flag PackageDB
regPackageDB
            (\Flag PackageDB
v RegisterFlags
flags -> RegisterFlags
flags{regPackageDB = v})
            ( [(Flag PackageDB, OptFlags, FilePath)]
-> MkOptDescr
     (RegisterFlags -> Flag PackageDB)
     (Flag PackageDB -> RegisterFlags -> RegisterFlags)
     RegisterFlags
forall b a.
Eq b =>
[(b, OptFlags, FilePath)] -> MkOptDescr (a -> b) (b -> a -> a) a
choiceOpt
                [
                  ( PackageDB -> Flag PackageDB
forall a. a -> Flag a
Flag PackageDB
UserPackageDB
                  , ([], [FilePath
"user"])
                  , FilePath
"upon registration, register this package in the user's local package database"
                  )
                ,
                  ( PackageDB -> Flag PackageDB
forall a. a -> Flag a
Flag PackageDB
GlobalPackageDB
                  , ([], [FilePath
"global"])
                  , FilePath
"(default)upon registration, register this package in the system-wide package database"
                  )
                ]
            )
        , FilePath
-> [FilePath]
-> FilePath
-> (RegisterFlags -> Flag Bool)
-> (Flag Bool -> RegisterFlags -> RegisterFlags)
-> MkOptDescr
     (RegisterFlags -> Flag Bool)
     (Flag Bool -> RegisterFlags -> RegisterFlags)
     RegisterFlags
-> OptionField RegisterFlags
forall get set a.
FilePath
-> [FilePath]
-> FilePath
-> get
-> set
-> MkOptDescr get set a
-> OptionField a
option
            FilePath
""
            [FilePath
"inplace"]
            FilePath
"register the package in the build location, so it can be used without being installed"
            RegisterFlags -> Flag Bool
regInPlace
            (\Flag Bool
v RegisterFlags
flags -> RegisterFlags
flags{regInPlace = v})
            MkOptDescr
  (RegisterFlags -> Flag Bool)
  (Flag Bool -> RegisterFlags -> RegisterFlags)
  RegisterFlags
forall a. MkOptDescr (a -> Flag Bool) (Flag Bool -> a -> a) a
trueArg
        , FilePath
-> [FilePath]
-> FilePath
-> (RegisterFlags -> Flag Bool)
-> (Flag Bool -> RegisterFlags -> RegisterFlags)
-> MkOptDescr
     (RegisterFlags -> Flag Bool)
     (Flag Bool -> RegisterFlags -> RegisterFlags)
     RegisterFlags
-> OptionField RegisterFlags
forall get set a.
FilePath
-> [FilePath]
-> FilePath
-> get
-> set
-> MkOptDescr get set a
-> OptionField a
option
            FilePath
""
            [FilePath
"gen-script"]
            FilePath
"instead of registering, generate a script to register later"
            RegisterFlags -> Flag Bool
regGenScript
            (\Flag Bool
v RegisterFlags
flags -> RegisterFlags
flags{regGenScript = v})
            MkOptDescr
  (RegisterFlags -> Flag Bool)
  (Flag Bool -> RegisterFlags -> RegisterFlags)
  RegisterFlags
forall a. MkOptDescr (a -> Flag Bool) (Flag Bool -> a -> a) a
trueArg
        , FilePath
-> [FilePath]
-> FilePath
-> (RegisterFlags -> Flag (Maybe FilePath))
-> (Flag (Maybe FilePath) -> RegisterFlags -> RegisterFlags)
-> MkOptDescr
     (RegisterFlags -> Flag (Maybe FilePath))
     (Flag (Maybe FilePath) -> RegisterFlags -> RegisterFlags)
     RegisterFlags
-> OptionField RegisterFlags
forall get set a.
FilePath
-> [FilePath]
-> FilePath
-> get
-> set
-> MkOptDescr get set a
-> OptionField a
option
            FilePath
""
            [FilePath
"gen-pkg-config"]
            FilePath
"instead of registering, generate a package registration file/directory"
            RegisterFlags -> Flag (Maybe FilePath)
regGenPkgConf
            (\Flag (Maybe FilePath)
v RegisterFlags
flags -> RegisterFlags
flags{regGenPkgConf = v})
            (FilePath
-> (Maybe FilePath -> Flag (Maybe FilePath))
-> (Flag (Maybe FilePath) -> [Maybe FilePath])
-> MkOptDescr
     (RegisterFlags -> Flag (Maybe FilePath))
     (Flag (Maybe FilePath) -> RegisterFlags -> RegisterFlags)
     RegisterFlags
forall b a.
Monoid b =>
FilePath
-> (Maybe FilePath -> b)
-> (b -> [Maybe FilePath])
-> MkOptDescr (a -> b) (b -> a -> a) a
optArg' FilePath
"PKG" Maybe FilePath -> Flag (Maybe FilePath)
forall a. a -> Flag a
Flag Flag (Maybe FilePath) -> [Maybe FilePath]
forall a. Flag a -> [a]
flagToList)
        , FilePath
-> [FilePath]
-> FilePath
-> (RegisterFlags -> Flag Bool)
-> (Flag Bool -> RegisterFlags -> RegisterFlags)
-> MkOptDescr
     (RegisterFlags -> Flag Bool)
     (Flag Bool -> RegisterFlags -> RegisterFlags)
     RegisterFlags
-> OptionField RegisterFlags
forall get set a.
FilePath
-> [FilePath]
-> FilePath
-> get
-> set
-> MkOptDescr get set a
-> OptionField a
option
            FilePath
""
            [FilePath
"print-ipid"]
            FilePath
"print the installed package ID calculated for this package"
            RegisterFlags -> Flag Bool
regPrintId
            (\Flag Bool
v RegisterFlags
flags -> RegisterFlags
flags{regPrintId = v})
            MkOptDescr
  (RegisterFlags -> Flag Bool)
  (Flag Bool -> RegisterFlags -> RegisterFlags)
  RegisterFlags
forall a. MkOptDescr (a -> Flag Bool) (Flag Bool -> a -> a) a
trueArg
        ]
    }

unregisterCommand :: CommandUI RegisterFlags
unregisterCommand :: CommandUI RegisterFlags
unregisterCommand =
  CommandUI
    { commandName :: FilePath
commandName = FilePath
"unregister"
    , commandSynopsis :: FilePath
commandSynopsis =
        FilePath
"Unregister this package with the compiler."
    , commandDescription :: Maybe ShowS
commandDescription = Maybe ShowS
forall a. Maybe a
Nothing
    , commandNotes :: Maybe ShowS
commandNotes = Maybe ShowS
forall a. Maybe a
Nothing
    , commandUsage :: ShowS
commandUsage = \FilePath
pname ->
        FilePath
"Usage: " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
pname FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
" unregister [FLAGS]\n"
    , commandDefaultFlags :: RegisterFlags
commandDefaultFlags = RegisterFlags
defaultRegisterFlags
    , commandOptions :: ShowOrParseArgs -> [OptionField RegisterFlags]
commandOptions = \ShowOrParseArgs
showOrParseArgs ->
        [ (RegisterFlags -> Flag Verbosity)
-> (Flag Verbosity -> RegisterFlags -> RegisterFlags)
-> OptionField RegisterFlags
forall flags.
(flags -> Flag Verbosity)
-> (Flag Verbosity -> flags -> flags) -> OptionField flags
optionVerbosity RegisterFlags -> Flag Verbosity
regVerbosity (\Flag Verbosity
v RegisterFlags
flags -> RegisterFlags
flags{regVerbosity = v})
        , (RegisterFlags -> Flag FilePath)
-> (Flag FilePath -> RegisterFlags -> RegisterFlags)
-> ShowOrParseArgs
-> OptionField RegisterFlags
forall flags.
(flags -> Flag FilePath)
-> (Flag FilePath -> flags -> flags)
-> ShowOrParseArgs
-> OptionField flags
optionDistPref
            RegisterFlags -> Flag FilePath
regDistPref
            (\Flag FilePath
d RegisterFlags
flags -> RegisterFlags
flags{regDistPref = d})
            ShowOrParseArgs
showOrParseArgs
        , FilePath
-> [FilePath]
-> FilePath
-> (RegisterFlags -> Flag PackageDB)
-> (Flag PackageDB -> RegisterFlags -> RegisterFlags)
-> MkOptDescr
     (RegisterFlags -> Flag PackageDB)
     (Flag PackageDB -> RegisterFlags -> RegisterFlags)
     RegisterFlags
-> OptionField RegisterFlags
forall get set a.
FilePath
-> [FilePath]
-> FilePath
-> get
-> set
-> MkOptDescr get set a
-> OptionField a
option
            FilePath
""
            [FilePath
"user"]
            FilePath
""
            RegisterFlags -> Flag PackageDB
regPackageDB
            (\Flag PackageDB
v RegisterFlags
flags -> RegisterFlags
flags{regPackageDB = v})
            ( [(Flag PackageDB, OptFlags, FilePath)]
-> MkOptDescr
     (RegisterFlags -> Flag PackageDB)
     (Flag PackageDB -> RegisterFlags -> RegisterFlags)
     RegisterFlags
forall b a.
Eq b =>
[(b, OptFlags, FilePath)] -> MkOptDescr (a -> b) (b -> a -> a) a
choiceOpt
                [
                  ( PackageDB -> Flag PackageDB
forall a. a -> Flag a
Flag PackageDB
UserPackageDB
                  , ([], [FilePath
"user"])
                  , FilePath
"unregister this package in the user's local package database"
                  )
                ,
                  ( PackageDB -> Flag PackageDB
forall a. a -> Flag a
Flag PackageDB
GlobalPackageDB
                  , ([], [FilePath
"global"])
                  , FilePath
"(default) unregister this package in the  system-wide package database"
                  )
                ]
            )
        , FilePath
-> [FilePath]
-> FilePath
-> (RegisterFlags -> Flag Bool)
-> (Flag Bool -> RegisterFlags -> RegisterFlags)
-> MkOptDescr
     (RegisterFlags -> Flag Bool)
     (Flag Bool -> RegisterFlags -> RegisterFlags)
     RegisterFlags
-> OptionField RegisterFlags
forall get set a.
FilePath
-> [FilePath]
-> FilePath
-> get
-> set
-> MkOptDescr get set a
-> OptionField a
option
            FilePath
""
            [FilePath
"gen-script"]
            FilePath
"Instead of performing the unregister command, generate a script to unregister later"
            RegisterFlags -> Flag Bool
regGenScript
            (\Flag Bool
v RegisterFlags
flags -> RegisterFlags
flags{regGenScript = v})
            MkOptDescr
  (RegisterFlags -> Flag Bool)
  (Flag Bool -> RegisterFlags -> RegisterFlags)
  RegisterFlags
forall a. MkOptDescr (a -> Flag Bool) (Flag Bool -> a -> a) a
trueArg
        ]
    }

emptyRegisterFlags :: RegisterFlags
emptyRegisterFlags :: RegisterFlags
emptyRegisterFlags = RegisterFlags
forall a. Monoid a => a
mempty

instance Monoid RegisterFlags where
  mempty :: RegisterFlags
mempty = RegisterFlags
forall a. (Generic a, GMonoid (Rep a)) => a
gmempty
  mappend :: RegisterFlags -> RegisterFlags -> RegisterFlags
mappend = RegisterFlags -> RegisterFlags -> RegisterFlags
forall a. Semigroup a => a -> a -> a
(<>)

instance Semigroup RegisterFlags where
  <> :: RegisterFlags -> RegisterFlags -> RegisterFlags
(<>) = RegisterFlags -> RegisterFlags -> RegisterFlags
forall a. (Generic a, GSemigroup (Rep a)) => a -> a -> a
gmappend