Cabal/src/Distribution/Simple/Setup/Copy.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.Copy
  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 copy command-line options.
  19 -- See: @Distribution.Simple.Setup@
  20 module Distribution.Simple.Setup.Copy
  21   ( CopyFlags (..)
  22   , emptyCopyFlags
  23   , defaultCopyFlags
  24   , copyCommand
  25   ) where
  26
  27 import Distribution.Compat.Prelude hiding (get)
  28 import Prelude ()
  29
  30 import Distribution.ReadE
  31 import Distribution.Simple.Command hiding (boolOpt, boolOpt')
  32 import Distribution.Simple.Flag
  33 import Distribution.Simple.InstallDirs
  34 import Distribution.Simple.Utils
  35 import Distribution.Verbosity
  36
  37 import Distribution.Simple.Setup.Common
  38
  39 -- ------------------------------------------------------------
  40
  41 -- * Copy flags
  42
  43 -- ------------------------------------------------------------
  44
  45 -- | Flags to @copy@: (destdir, copy-prefix (backwards compat), verbosity)
  46 data CopyFlags = CopyFlags
  47   { copyDest :: Flag CopyDest
  48   , copyDistPref :: Flag FilePath
  49   , copyVerbosity :: Flag Verbosity
  50   , -- This is the same hack as in 'buildArgs'.  But I (ezyang) don't
  51     -- think it's a hack, it's the right way to make hooks more robust
  52     -- TODO: Stop using this eventually when 'UserHooks' gets changed
  53     copyArgs :: [String]
  54   , copyCabalFilePath :: Flag FilePath
  55   }
  56   deriving (Show, Generic)
  57
  58 defaultCopyFlags :: CopyFlags
  59 defaultCopyFlags =
  60   CopyFlags
  61     { copyDest = Flag NoCopyDest
  62     , copyDistPref = NoFlag
  63     , copyVerbosity = Flag normal
  64     , copyArgs = []
  65     , copyCabalFilePath = mempty
  66     }
  67
  68 copyCommand :: CommandUI CopyFlags
  69 copyCommand =
  70   CommandUI
  71     { commandName = "copy"
  72     , commandSynopsis = "Copy the files of all/specific components to install locations."
  73     , commandDescription = Just $ \_ ->
  74         wrapText $
  75           "Components encompass executables and libraries. "
  76             ++ "Does not call register, and allows a prefix at install time. "
  77             ++ "Without the --destdir flag, configure determines location.\n"
  78     , commandNotes = Just $ \pname ->
  79         "Examples:\n"
  80           ++ "  "
  81           ++ pname
  82           ++ " copy           "
  83           ++ "    All the components in the package\n"
  84           ++ "  "
  85           ++ pname
  86           ++ " copy foo       "
  87           ++ "    A component (i.e. lib, exe, test suite)"
  88     , commandUsage =
  89         usageAlternatives "copy" $
  90           [ "[FLAGS]"
  91           , "COMPONENTS [FLAGS]"
  92           ]
  93     , commandDefaultFlags = defaultCopyFlags
  94     , commandOptions = \showOrParseArgs -> case showOrParseArgs of
  95         ShowArgs ->
  96           filter
  97             ( (`notElem` ["target-package-db"])
  98                 . optionName
  99             )
 100             $ copyOptions ShowArgs
 101         ParseArgs -> copyOptions ParseArgs
 102     }
 103
 104 copyOptions :: ShowOrParseArgs -> [OptionField CopyFlags]
 105 copyOptions showOrParseArgs =
 106   [ optionVerbosity copyVerbosity (\v flags -> flags{copyVerbosity = v})
 107   , optionDistPref
 108       copyDistPref
 109       (\d flags -> flags{copyDistPref = d})
 110       showOrParseArgs
 111   , option
 112       ""
 113       ["destdir"]
 114       "directory to copy files to, prepended to installation directories"
 115       copyDest
 116       ( \v flags -> case copyDest flags of
 117           Flag (CopyToDb _) -> error "Use either 'destdir' or 'target-package-db'."
 118           _ -> flags{copyDest = v}
 119       )
 120       ( reqArg
 121           "DIR"
 122           (succeedReadE (Flag . CopyTo))
 123           (\f -> case f of Flag (CopyTo p) -> [p]; _ -> [])
 124       )
 125   , option
 126       ""
 127       ["target-package-db"]
 128       "package database to copy files into. Required when using ${pkgroot} prefix."
 129       copyDest
 130       ( \v flags -> case copyDest flags of
 131           NoFlag -> flags{copyDest = v}
 132           Flag NoCopyDest -> flags{copyDest = v}
 133           _ -> error "Use either 'destdir' or 'target-package-db'."
 134       )
 135       ( reqArg
 136           "DATABASE"
 137           (succeedReadE (Flag . CopyToDb))
 138           (\f -> case f of Flag (CopyToDb p) -> [p]; _ -> [])
 139       )
 140   ]
 141
 142 emptyCopyFlags :: CopyFlags
 143 emptyCopyFlags = mempty
 144
 145 instance Monoid CopyFlags where
 146   mempty = gmempty
 147   mappend = (<>)
 148
 149 instance Semigroup CopyFlags where
 150   (<>) = gmappend