{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ViewPatterns #-}

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

-- |
-- 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
      ( RegisterCommonFlags
      , registerVerbosity
      , registerDistPref
      , registerCabalFilePath
      , registerWorkingDir
      , registerTargets
      , ..
      )
  , 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.Simple.Setup.Common
import Distribution.Utils.Path
import Distribution.Verbosity

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

-- * Register flags

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

-- | Flags to @register@ and @unregister@: (user package, gen-script,
-- in-place, verbosity)
data RegisterFlags = RegisterFlags
  { RegisterFlags -> CommonSetupFlags
registerCommonFlags :: !CommonSetupFlags
  , 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 Bool
regPrintId :: Flag Bool
  }
  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)

pattern RegisterCommonFlags
  :: Flag Verbosity
  -> Flag (SymbolicPath Pkg (Dir Dist))
  -> Flag (SymbolicPath CWD (Dir Pkg))
  -> Flag (SymbolicPath Pkg File)
  -> [String]
  -> RegisterFlags
pattern $mRegisterCommonFlags :: forall {r}.
RegisterFlags
-> (Flag Verbosity
    -> Flag (SymbolicPath Pkg ('Dir Dist))
    -> Flag (SymbolicPath CWD ('Dir Pkg))
    -> Flag (SymbolicPath Pkg 'File)
    -> [FilePath]
    -> r)
-> ((# #) -> r)
-> r
RegisterCommonFlags
  { RegisterFlags -> Flag Verbosity
registerVerbosity
  , RegisterFlags -> Flag (SymbolicPath Pkg ('Dir Dist))
registerDistPref
  , RegisterFlags -> Flag (SymbolicPath CWD ('Dir Pkg))
registerWorkingDir
  , RegisterFlags -> Flag (SymbolicPath Pkg 'File)
registerCabalFilePath
  , RegisterFlags -> [FilePath]
registerTargets
  } <-
  ( registerCommonFlags ->
      CommonSetupFlags
        { setupVerbosity = registerVerbosity
        , setupDistPref = registerDistPref
        , setupWorkingDir = registerWorkingDir
        , setupCabalFilePath = registerCabalFilePath
        , setupTargets = registerTargets
        }
    )

defaultRegisterFlags :: RegisterFlags
defaultRegisterFlags :: RegisterFlags
defaultRegisterFlags =
  RegisterFlags
    { registerCommonFlags :: CommonSetupFlags
registerCommonFlags = CommonSetupFlags
defaultCommonSetupFlags
    , 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
    , regPrintId :: Flag Bool
regPrintId = Bool -> Flag Bool
forall a. a -> Flag a
Flag Bool
False
    }

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 -> CommonSetupFlags)
-> (CommonSetupFlags -> RegisterFlags -> RegisterFlags)
-> ShowOrParseArgs
-> [OptionField RegisterFlags]
-> [OptionField RegisterFlags]
forall flags.
(flags -> CommonSetupFlags)
-> (CommonSetupFlags -> flags -> flags)
-> ShowOrParseArgs
-> [OptionField flags]
-> [OptionField flags]
withCommonSetupOptions
          RegisterFlags -> CommonSetupFlags
registerCommonFlags
          (\CommonSetupFlags
c RegisterFlags
f -> RegisterFlags
f{registerCommonFlags = c})
          ShowOrParseArgs
showOrParseArgs
          ([OptionField RegisterFlags] -> [OptionField RegisterFlags])
-> [OptionField RegisterFlags] -> [OptionField RegisterFlags]
forall a b. (a -> b) -> a -> b
$ [ 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 -> CommonSetupFlags)
-> (CommonSetupFlags -> RegisterFlags -> RegisterFlags)
-> ShowOrParseArgs
-> [OptionField RegisterFlags]
-> [OptionField RegisterFlags]
forall flags.
(flags -> CommonSetupFlags)
-> (CommonSetupFlags -> flags -> flags)
-> ShowOrParseArgs
-> [OptionField flags]
-> [OptionField flags]
withCommonSetupOptions
          RegisterFlags -> CommonSetupFlags
registerCommonFlags
          (\CommonSetupFlags
c RegisterFlags
f -> RegisterFlags
f{registerCommonFlags = c})
          ShowOrParseArgs
showOrParseArgs
          ([OptionField RegisterFlags] -> [OptionField RegisterFlags])
-> [OptionField RegisterFlags] -> [OptionField RegisterFlags]
forall a b. (a -> b) -> a -> b
$ [ 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