Cabal/src/Distribution/Simple/Setup/Copy.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.Copy
  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 copy command-line options.
  22 -- See: @Distribution.Simple.Setup@
  23 module Distribution.Simple.Setup.Copy
  24   ( CopyFlags
  25       ( CopyCommonFlags
  26       , copyVerbosity
  27       , copyDistPref
  28       , copyCabalFilePath
  29       , copyWorkingDir
  30       , copyTargets
  31       , ..
  32       )
  33   , emptyCopyFlags
  34   , defaultCopyFlags
  35   , copyCommand
  36   ) where
  37
  38 import Distribution.Compat.Prelude hiding (get)
  39 import Prelude ()
  40
  41 import Distribution.ReadE
  42 import Distribution.Simple.Command hiding (boolOpt, boolOpt')
  43 import Distribution.Simple.Flag
  44 import Distribution.Simple.InstallDirs
  45 import Distribution.Simple.Setup.Common
  46 import Distribution.Simple.Utils
  47 import Distribution.Utils.Path
  48 import Distribution.Verbosity
  49
  50 -- ------------------------------------------------------------
  51
  52 -- * Copy flags
  53
  54 -- ------------------------------------------------------------
  55
  56 -- | Flags to @copy@: (destdir, copy-prefix (backwards compat), verbosity)
  57 data CopyFlags = CopyFlags
  58   { copyCommonFlags :: !CommonSetupFlags
  59   , copyDest :: Flag CopyDest
  60   }
  61   deriving (Show, Generic)
  62
  63 pattern CopyCommonFlags
  64   :: Flag Verbosity
  65   -> Flag (SymbolicPath Pkg (Dir Dist))
  66   -> Flag (SymbolicPath CWD (Dir Pkg))
  67   -> Flag (SymbolicPath Pkg File)
  68   -> [String]
  69   -> CopyFlags
  70 pattern CopyCommonFlags
  71   { copyVerbosity
  72   , copyDistPref
  73   , copyWorkingDir
  74   , copyCabalFilePath
  75   , copyTargets
  76   } <-
  77   ( copyCommonFlags ->
  78       CommonSetupFlags
  79         { setupVerbosity = copyVerbosity
  80         , setupDistPref = copyDistPref
  81         , setupWorkingDir = copyWorkingDir
  82         , setupCabalFilePath = copyCabalFilePath
  83         , setupTargets = copyTargets
  84         }
  85     )
  86
  87 instance Binary CopyFlags
  88 instance Structured CopyFlags
  89
  90 defaultCopyFlags :: CopyFlags
  91 defaultCopyFlags =
  92   CopyFlags
  93     { copyCommonFlags = defaultCommonSetupFlags
  94     , copyDest = Flag NoCopyDest
  95     }
  96
  97 copyCommand :: CommandUI CopyFlags
  98 copyCommand =
  99   CommandUI
 100     { commandName = "copy"
 101     , commandSynopsis = "Copy the files of all/specific components to install locations."
 102     , commandDescription = Just $ \_ ->
 103         wrapText $
 104           "Components encompass executables and libraries. "
 105             ++ "Does not call register, and allows a prefix at install time. "
 106             ++ "Without the --destdir flag, configure determines location.\n"
 107     , commandNotes = Just $ \pname ->
 108         "Examples:\n"
 109           ++ "  "
 110           ++ pname
 111           ++ " copy           "
 112           ++ "    All the components in the package\n"
 113           ++ "  "
 114           ++ pname
 115           ++ " copy foo       "
 116           ++ "    A component (i.e. lib, exe, test suite)"
 117     , commandUsage =
 118         usageAlternatives "copy" $
 119           [ "[FLAGS]"
 120           , "COMPONENTS [FLAGS]"
 121           ]
 122     , commandDefaultFlags = defaultCopyFlags
 123     , commandOptions = \showOrParseArgs -> case showOrParseArgs of
 124         ShowArgs ->
 125           filter
 126             ( (`notElem` ["target-package-db"])
 127                 . optionName
 128             )
 129             $ copyOptions ShowArgs
 130         ParseArgs -> copyOptions ParseArgs
 131     }
 132
 133 copyOptions :: ShowOrParseArgs -> [OptionField CopyFlags]
 134 copyOptions showOrParseArgs =
 135   withCommonSetupOptions
 136     copyCommonFlags
 137     (\c f -> f{copyCommonFlags = c})
 138     showOrParseArgs
 139     [ option
 140         ""
 141         ["destdir"]
 142         "directory to copy files to, prepended to installation directories"
 143         copyDest
 144         ( \v flags -> case copyDest flags of
 145             Flag (CopyToDb _) -> error "Use either 'destdir' or 'target-package-db'."
 146             _ -> flags{copyDest = v}
 147         )
 148         ( reqArg
 149             "DIR"
 150             (succeedReadE (Flag . CopyTo))
 151             (\f -> case f of Flag (CopyTo p) -> [p]; _ -> [])
 152         )
 153     , option
 154         ""
 155         ["target-package-db"]
 156         "package database to copy files into. Required when using ${pkgroot} prefix."
 157         copyDest
 158         ( \v flags -> case copyDest flags of
 159             NoFlag -> flags{copyDest = v}
 160             Flag NoCopyDest -> flags{copyDest = v}
 161             _ -> error "Use either 'destdir' or 'target-package-db'."
 162         )
 163         ( reqArg
 164             "DATABASE"
 165             (succeedReadE (Flag . CopyToDb))
 166             (\f -> case f of Flag (CopyToDb p) -> [p]; _ -> [])
 167         )
 168     ]
 169
 170 emptyCopyFlags :: CopyFlags
 171 emptyCopyFlags = mempty
 172
 173 instance Monoid CopyFlags where
 174   mempty = gmempty
 175   mappend = (<>)
 176
 177 instance Semigroup CopyFlags where
 178   (<>) = gmappend