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

-- |
-- Module      :  Distribution.Simple.Setup.Install
-- Copyright   :  Isaac Jones 2003-2004
--                Duncan Coutts 2007
-- License     :  BSD3
--
-- Maintainer  :  cabal-devel@haskell.org
-- Portability :  portable
--
-- Definition of the install command-line options.
-- See: @Distribution.Simple.Setup@
module Distribution.Simple.Setup.Install
  ( InstallFlags
      ( InstallCommonFlags
      , installVerbosity
      , installDistPref
      , installCabalFilePath
      , installWorkingDir
      , installTargets
      , ..
      )
  , emptyInstallFlags
  , defaultInstallFlags
  , installCommand
  ) where

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

import Distribution.ReadE
import Distribution.Simple.Command hiding (boolOpt, boolOpt')
import Distribution.Simple.Compiler
import Distribution.Simple.Flag
import Distribution.Simple.InstallDirs
import Distribution.Simple.Setup.Common
import Distribution.Simple.Utils
import Distribution.Utils.Path
import Distribution.Verbosity

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

-- * Install flags

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

-- | Flags to @install@: (package db, verbosity)
data InstallFlags = InstallFlags
  { InstallFlags -> CommonSetupFlags
installCommonFlags :: !CommonSetupFlags
  , InstallFlags -> Last PackageDB
installPackageDB :: Flag PackageDB
  , InstallFlags -> Last CopyDest
installDest :: Flag CopyDest
  , InstallFlags -> Flag Bool
installUseWrapper :: Flag Bool
  , InstallFlags -> Flag Bool
installInPlace :: Flag Bool
  }
  deriving (Int -> InstallFlags -> ShowS
[InstallFlags] -> ShowS
InstallFlags -> [Char]
(Int -> InstallFlags -> ShowS)
-> (InstallFlags -> [Char])
-> ([InstallFlags] -> ShowS)
-> Show InstallFlags
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> InstallFlags -> ShowS
showsPrec :: Int -> InstallFlags -> ShowS
$cshow :: InstallFlags -> [Char]
show :: InstallFlags -> [Char]
$cshowList :: [InstallFlags] -> ShowS
showList :: [InstallFlags] -> ShowS
Show, (forall x. InstallFlags -> Rep InstallFlags x)
-> (forall x. Rep InstallFlags x -> InstallFlags)
-> Generic InstallFlags
forall x. Rep InstallFlags x -> InstallFlags
forall x. InstallFlags -> Rep InstallFlags x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. InstallFlags -> Rep InstallFlags x
from :: forall x. InstallFlags -> Rep InstallFlags x
$cto :: forall x. Rep InstallFlags x -> InstallFlags
to :: forall x. Rep InstallFlags x -> InstallFlags
Generic)

pattern InstallCommonFlags
  :: Flag Verbosity
  -> Flag (SymbolicPath Pkg (Dir Dist))
  -> Flag (SymbolicPath CWD (Dir Pkg))
  -> Flag (SymbolicPath Pkg File)
  -> [String]
  -> InstallFlags
pattern $mInstallCommonFlags :: forall {r}.
InstallFlags
-> (Flag Verbosity
    -> Flag (SymbolicPath Pkg ('Dir Dist))
    -> Flag (SymbolicPath CWD ('Dir Pkg))
    -> Flag (SymbolicPath Pkg 'File)
    -> [[Char]]
    -> r)
-> ((# #) -> r)
-> r
InstallCommonFlags
  { InstallFlags -> Flag Verbosity
installVerbosity
  , InstallFlags -> Flag (SymbolicPath Pkg ('Dir Dist))
installDistPref
  , InstallFlags -> Flag (SymbolicPath CWD ('Dir Pkg))
installWorkingDir
  , InstallFlags -> Flag (SymbolicPath Pkg 'File)
installCabalFilePath
  , InstallFlags -> [[Char]]
installTargets
  } <-
  ( installCommonFlags ->
      CommonSetupFlags
        { setupVerbosity = installVerbosity
        , setupDistPref = installDistPref
        , setupWorkingDir = installWorkingDir
        , setupCabalFilePath = installCabalFilePath
        , setupTargets = installTargets
        }
    )

defaultInstallFlags :: InstallFlags
defaultInstallFlags :: InstallFlags
defaultInstallFlags =
  InstallFlags
    { installCommonFlags :: CommonSetupFlags
installCommonFlags = CommonSetupFlags
defaultCommonSetupFlags
    , installPackageDB :: Last PackageDB
installPackageDB = Last PackageDB
forall a. Last a
NoFlag
    , installDest :: Last CopyDest
installDest = CopyDest -> Last CopyDest
forall a. a -> Last a
Flag CopyDest
NoCopyDest
    , installUseWrapper :: Flag Bool
installUseWrapper = Bool -> Flag Bool
forall a. a -> Last a
Flag Bool
False
    , installInPlace :: Flag Bool
installInPlace = Bool -> Flag Bool
forall a. a -> Last a
Flag Bool
False
    }

installCommand :: CommandUI InstallFlags
installCommand :: CommandUI InstallFlags
installCommand =
  CommandUI
    { commandName :: [Char]
commandName = [Char]
"install"
    , commandSynopsis :: [Char]
commandSynopsis =
        [Char]
"Copy the files into the install locations. Run register."
    , commandDescription :: Maybe ShowS
commandDescription = ShowS -> Maybe ShowS
forall a. a -> Maybe a
Just (ShowS -> Maybe ShowS) -> ShowS -> Maybe ShowS
forall a b. (a -> b) -> a -> b
$ \[Char]
_ ->
        ShowS
wrapText ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
          [Char]
"Unlike the copy command, install calls the register command. "
            [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"If you want to install into a location that is not what was "
            [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"specified in the configure step, use the copy command.\n"
    , commandNotes :: Maybe ShowS
commandNotes = Maybe ShowS
forall a. Maybe a
Nothing
    , commandUsage :: ShowS
commandUsage = \[Char]
pname ->
        [Char]
"Usage: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
pname [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" install [FLAGS]\n"
    , commandDefaultFlags :: InstallFlags
commandDefaultFlags = InstallFlags
defaultInstallFlags
    , commandOptions :: ShowOrParseArgs -> [OptionField InstallFlags]
commandOptions = \ShowOrParseArgs
showOrParseArgs ->
        (InstallFlags -> CommonSetupFlags)
-> (CommonSetupFlags -> InstallFlags -> InstallFlags)
-> ShowOrParseArgs
-> [OptionField InstallFlags]
-> [OptionField InstallFlags]
forall flags.
(flags -> CommonSetupFlags)
-> (CommonSetupFlags -> flags -> flags)
-> ShowOrParseArgs
-> [OptionField flags]
-> [OptionField flags]
withCommonSetupOptions
          InstallFlags -> CommonSetupFlags
installCommonFlags
          (\CommonSetupFlags
c InstallFlags
f -> InstallFlags
f{installCommonFlags = c})
          ShowOrParseArgs
showOrParseArgs
          ([OptionField InstallFlags] -> [OptionField InstallFlags])
-> [OptionField InstallFlags] -> [OptionField InstallFlags]
forall a b. (a -> b) -> a -> b
$ case ShowOrParseArgs
showOrParseArgs of
            ShowOrParseArgs
ShowArgs ->
              (OptionField InstallFlags -> Bool)
-> [OptionField InstallFlags] -> [OptionField InstallFlags]
forall a. (a -> Bool) -> [a] -> [a]
filter
                ( ([Char] -> [[Char]] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [[Char]
"target-package-db"])
                    ([Char] -> Bool)
-> (OptionField InstallFlags -> [Char])
-> OptionField InstallFlags
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OptionField InstallFlags -> [Char]
forall a. OptionField a -> [Char]
optionName
                )
                [OptionField InstallFlags]
installOptions
            ShowOrParseArgs
ParseArgs -> [OptionField InstallFlags]
installOptions
    }

installOptions :: [OptionField InstallFlags]
installOptions :: [OptionField InstallFlags]
installOptions =
  [ [Char]
-> [[Char]]
-> [Char]
-> (InstallFlags -> Flag Bool)
-> (Flag Bool -> InstallFlags -> InstallFlags)
-> MkOptDescr
     (InstallFlags -> Flag Bool)
     (Flag Bool -> InstallFlags -> InstallFlags)
     InstallFlags
-> OptionField InstallFlags
forall get set a.
[Char]
-> [[Char]]
-> [Char]
-> get
-> set
-> MkOptDescr get set a
-> OptionField a
option
      [Char]
""
      [[Char]
"inplace"]
      [Char]
"install the package in the install subdirectory of the dist prefix, so it can be used without being installed"
      InstallFlags -> Flag Bool
installInPlace
      (\Flag Bool
v InstallFlags
flags -> InstallFlags
flags{installInPlace = v})
      MkOptDescr
  (InstallFlags -> Flag Bool)
  (Flag Bool -> InstallFlags -> InstallFlags)
  InstallFlags
forall a. MkOptDescr (a -> Flag Bool) (Flag Bool -> a -> a) a
trueArg
  , [Char]
-> [[Char]]
-> [Char]
-> (InstallFlags -> Flag Bool)
-> (Flag Bool -> InstallFlags -> InstallFlags)
-> MkOptDescr
     (InstallFlags -> Flag Bool)
     (Flag Bool -> InstallFlags -> InstallFlags)
     InstallFlags
-> OptionField InstallFlags
forall get set a.
[Char]
-> [[Char]]
-> [Char]
-> get
-> set
-> MkOptDescr get set a
-> OptionField a
option
      [Char]
""
      [[Char]
"shell-wrappers"]
      [Char]
"using shell script wrappers around executables"
      InstallFlags -> Flag Bool
installUseWrapper
      (\Flag Bool
v InstallFlags
flags -> InstallFlags
flags{installUseWrapper = v})
      ([Char]
-> [Char]
-> MkOptDescr
     (InstallFlags -> Flag Bool)
     (Flag Bool -> InstallFlags -> InstallFlags)
     InstallFlags
forall a.
[Char]
-> [Char] -> MkOptDescr (a -> Flag Bool) (Flag Bool -> a -> a) a
boolOpt [] [])
  , [Char]
-> [[Char]]
-> [Char]
-> (InstallFlags -> Last PackageDB)
-> (Last PackageDB -> InstallFlags -> InstallFlags)
-> MkOptDescr
     (InstallFlags -> Last PackageDB)
     (Last PackageDB -> InstallFlags -> InstallFlags)
     InstallFlags
-> OptionField InstallFlags
forall get set a.
[Char]
-> [[Char]]
-> [Char]
-> get
-> set
-> MkOptDescr get set a
-> OptionField a
option
      [Char]
""
      [[Char]
"package-db"]
      [Char]
""
      InstallFlags -> Last PackageDB
installPackageDB
      (\Last PackageDB
v InstallFlags
flags -> InstallFlags
flags{installPackageDB = v})
      ( [(Last PackageDB, OptFlags, [Char])]
-> MkOptDescr
     (InstallFlags -> Last PackageDB)
     (Last PackageDB -> InstallFlags -> InstallFlags)
     InstallFlags
forall b a.
Eq b =>
[(b, OptFlags, [Char])] -> MkOptDescr (a -> b) (b -> a -> a) a
choiceOpt
          [
            ( PackageDB -> Last PackageDB
forall a. a -> Last a
Flag PackageDB
forall fp. PackageDBX fp
UserPackageDB
            , ([], [[Char]
"user"])
            , [Char]
"upon configuration register this package in the user's local package database"
            )
          ,
            ( PackageDB -> Last PackageDB
forall a. a -> Last a
Flag PackageDB
forall fp. PackageDBX fp
GlobalPackageDB
            , ([], [[Char]
"global"])
            , [Char]
"(default) upon configuration register this package in the system-wide package database"
            )
          ]
      )
  , [Char]
-> [[Char]]
-> [Char]
-> (InstallFlags -> Last CopyDest)
-> (Last CopyDest -> InstallFlags -> InstallFlags)
-> MkOptDescr
     (InstallFlags -> Last CopyDest)
     (Last CopyDest -> InstallFlags -> InstallFlags)
     InstallFlags
-> OptionField InstallFlags
forall get set a.
[Char]
-> [[Char]]
-> [Char]
-> get
-> set
-> MkOptDescr get set a
-> OptionField a
option
      [Char]
""
      [[Char]
"target-package-db"]
      [Char]
"package database to install into. Required when using ${pkgroot} prefix."
      InstallFlags -> Last CopyDest
installDest
      (\Last CopyDest
v InstallFlags
flags -> InstallFlags
flags{installDest = v})
      ( [Char]
-> ReadE (Last CopyDest)
-> (Last CopyDest -> [[Char]])
-> MkOptDescr
     (InstallFlags -> Last CopyDest)
     (Last CopyDest -> InstallFlags -> InstallFlags)
     InstallFlags
forall b a.
Monoid b =>
[Char]
-> ReadE b
-> (b -> [[Char]])
-> MkOptDescr (a -> b) (b -> a -> a) a
reqArg
          [Char]
"DATABASE"
          (([Char] -> Last CopyDest) -> ReadE (Last CopyDest)
forall a. ([Char] -> a) -> ReadE a
succeedReadE (CopyDest -> Last CopyDest
forall a. a -> Last a
Flag (CopyDest -> Last CopyDest)
-> ([Char] -> CopyDest) -> [Char] -> Last CopyDest
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> CopyDest
CopyToDb))
          (\Last CopyDest
f -> case Last CopyDest
f of Flag (CopyToDb [Char]
p) -> [[Char]
p]; Last CopyDest
_ -> [])
      )
  ]

emptyInstallFlags :: InstallFlags
emptyInstallFlags :: InstallFlags
emptyInstallFlags = InstallFlags
forall a. Monoid a => a
mempty

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

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