Cabal/src/Distribution/Simple/Setup.hs

   1 {-# LANGUAGE CPP #-}
   2 {-# LANGUAGE DataKinds #-}
   3 {-# LANGUAGE DeriveDataTypeable #-}
   4 {-# LANGUAGE DeriveGeneric #-}
   5 {-# LANGUAGE FlexibleContexts #-}
   6 {-# LANGUAGE LambdaCase #-}
   7 {-# LANGUAGE RankNTypes #-}
   8
   9 -----------------------------------------------------------------------------
  10
  11 -- |
  12 -- Module      :  Distribution.Simple.Setup
  13 -- Copyright   :  Isaac Jones 2003-2004
  14 --                Duncan Coutts 2007
  15 -- License     :  BSD3
  16 --
  17 -- Maintainer  :  cabal-devel@haskell.org
  18 -- Portability :  portable
  19 --
  20 -- This module defines the command line interface for all the Cabal
  21 -- commands. For each command (like @configure@, @build@ etc) it defines a type
  22 -- that holds all the flags, the default set of flags and a 'CommandUI' that
  23 -- maps command line flags to and from the corresponding flags type.
  24 --
  25 -- All the flags types are instances of 'Monoid', see
  26 -- <http://www.haskell.org/pipermail/cabal-devel/2007-December/001509.html>
  27 -- for an explanation.
  28 --
  29 -- The types defined here get used in the front end and especially in
  30 -- @cabal-install@ which has to do quite a bit of manipulating sets of command
  31 -- line flags.
  32 --
  33 -- This is actually relatively nice, it works quite well. The main change it
  34 -- needs is to unify it with the code for managing sets of fields that can be
  35 -- read and written from files. This would allow us to save configure flags in
  36 -- config files.
  37 module Distribution.Simple.Setup
  38   ( GlobalFlags (..)
  39   , emptyGlobalFlags
  40   , defaultGlobalFlags
  41   , globalCommand
  42   , CommonSetupFlags (..)
  43   , defaultCommonSetupFlags
  44   , commonSetupTempFileOptions
  45   , ConfigFlags (..)
  46   , emptyConfigFlags
  47   , defaultConfigFlags
  48   , configureCommand
  49   , configPrograms
  50   , readPackageDb
  51   , readPackageDbList
  52   , showPackageDb
  53   , showPackageDbList
  54   , CopyFlags (..)
  55   , emptyCopyFlags
  56   , defaultCopyFlags
  57   , copyCommand
  58   , InstallFlags (..)
  59   , emptyInstallFlags
  60   , defaultInstallFlags
  61   , installCommand
  62   , HaddockTarget (..)
  63   , HaddockFlags (..)
  64   , emptyHaddockFlags
  65   , defaultHaddockFlags
  66   , haddockCommand
  67   , Visibility (..)
  68   , HaddockProjectFlags (..)
  69   , emptyHaddockProjectFlags
  70   , defaultHaddockProjectFlags
  71   , haddockProjectCommand
  72   , HscolourFlags (..)
  73   , emptyHscolourFlags
  74   , defaultHscolourFlags
  75   , hscolourCommand
  76   , BuildFlags (..)
  77   , emptyBuildFlags
  78   , defaultBuildFlags
  79   , buildCommand
  80   , DumpBuildInfo (..)
  81   , ReplFlags (..)
  82   , defaultReplFlags
  83   , replCommand
  84   , ReplOptions (..)
  85   , CleanFlags (..)
  86   , emptyCleanFlags
  87   , defaultCleanFlags
  88   , cleanCommand
  89   , RegisterFlags (..)
  90   , emptyRegisterFlags
  91   , defaultRegisterFlags
  92   , registerCommand
  93   , unregisterCommand
  94   , SDistFlags (..)
  95   , emptySDistFlags
  96   , defaultSDistFlags
  97   , sdistCommand
  98   , TestFlags (..)
  99   , emptyTestFlags
 100   , defaultTestFlags
 101   , testCommand
 102   , TestShowDetails (..)
 103   , BenchmarkFlags (..)
 104   , emptyBenchmarkFlags
 105   , defaultBenchmarkFlags
 106   , benchmarkCommand
 107   , CopyDest (..)
 108   , configureArgs
 109   , configureOptions
 110   , configureCCompiler
 111   , configureLinker
 112   , buildOptions
 113   , haddockOptions
 114   , haddockProjectOptions
 115   , installDirsOptions
 116   , testOptions'
 117   , benchmarkOptions'
 118   , programDbOptions
 119   , programDbPaths'
 120   , programFlagsDescription
 121   , replOptions
 122   , splitArgs
 123   , defaultDistPref
 124   , optionDistPref
 125   , Flag (..)
 126   , toFlag
 127   , fromFlag
 128   , fromFlagOrDefault
 129   , flagToMaybe
 130   , flagToList
 131   , maybeToFlag
 132   , BooleanFlag (..)
 133   , boolOpt
 134   , boolOpt'
 135   , trueArg
 136   , falseArg
 137   , optionVerbosity
 138   , BuildingWhat (..)
 139   , buildingWhatCommonFlags
 140   , buildingWhatVerbosity
 141   , buildingWhatWorkingDir
 142   , buildingWhatDistPref
 143   ) where
 144
 145 import Distribution.Compat.Prelude
 146 import Prelude ()
 147
 148 import Distribution.Simple.Flag
 149 import Distribution.Simple.InstallDirs
 150 import Distribution.Types.DumpBuildInfo
 151
 152 import Distribution.Simple.Setup.Benchmark
 153 import Distribution.Simple.Setup.Build
 154 import Distribution.Simple.Setup.Clean
 155 import Distribution.Simple.Setup.Common
 156 import Distribution.Simple.Setup.Config
 157 import Distribution.Simple.Setup.Copy
 158 import Distribution.Simple.Setup.Global
 159 import Distribution.Simple.Setup.Haddock
 160 import Distribution.Simple.Setup.Hscolour
 161 import Distribution.Simple.Setup.Install
 162 import Distribution.Simple.Setup.Register
 163   ( RegisterFlags (..)
 164   , defaultRegisterFlags
 165   , emptyRegisterFlags
 166   , registerCommand
 167   , unregisterCommand
 168   )
 169 import Distribution.Simple.Setup.Repl
 170 import Distribution.Simple.Setup.SDist
 171 import Distribution.Simple.Setup.Test
 172 import Distribution.Utils.Path
 173
 174 import Distribution.Verbosity (Verbosity)
 175
 176 -- | What kind of build phase are we doing/hooking into?
 177 --
 178 -- Is this a normal build, or is it perhaps for running an interactive
 179 -- session or Haddock?
 180 data BuildingWhat
 181   = -- | A normal build.
 182     BuildNormal BuildFlags
 183   | -- | Build steps for an interactive session.
 184     BuildRepl ReplFlags
 185   | -- | Build steps for generating documentation.
 186     BuildHaddock HaddockFlags
 187   | -- | Build steps for Hscolour.
 188     BuildHscolour HscolourFlags
 189   deriving (Generic, Show)
 190
 191 buildingWhatCommonFlags :: BuildingWhat -> CommonSetupFlags
 192 buildingWhatCommonFlags = \case
 193   BuildNormal flags -> buildCommonFlags flags
 194   BuildRepl flags -> replCommonFlags flags
 195   BuildHaddock flags -> haddockCommonFlags flags
 196   BuildHscolour flags -> hscolourCommonFlags flags
 197
 198 buildingWhatVerbosity :: BuildingWhat -> Verbosity
 199 buildingWhatVerbosity = fromFlag . setupVerbosity . buildingWhatCommonFlags
 200
 201 buildingWhatWorkingDir :: BuildingWhat -> Maybe (SymbolicPath CWD (Dir Pkg))
 202 buildingWhatWorkingDir = flagToMaybe . setupWorkingDir . buildingWhatCommonFlags
 203
 204 buildingWhatDistPref :: BuildingWhat -> SymbolicPath Pkg (Dir Dist)
 205 buildingWhatDistPref = fromFlag . setupDistPref . buildingWhatCommonFlags
 206
 207 -- The test cases kinda have to be rewritten from the ground up... :/
 208 -- hunitTests :: [Test]
 209 -- hunitTests =
 210 --    let m = [("ghc", GHC), ("nhc98", NHC), ("hugs", Hugs)]
 211 --        (flags, commands', unkFlags, ers)
 212 --               = getOpt Permute options ["configure", "foobar", "--prefix=/foo", "--ghc", "--nhc98", "--hugs", "--with-compiler=/comp", "--unknown1", "--unknown2", "--install-prefix=/foo", "--user", "--global"]
 213 --       in  [TestLabel "very basic option parsing" $ TestList [
 214 --                 "getOpt flags" ~: "failed" ~:
 215 --                 [Prefix "/foo", GhcFlag, NhcFlag, HugsFlag,
 216 --                  WithCompiler "/comp", InstPrefix "/foo", UserFlag, GlobalFlag]
 217 --                 ~=? flags,
 218 --                 "getOpt commands" ~: "failed" ~: ["configure", "foobar"] ~=? commands',
 219 --                 "getOpt unknown opts" ~: "failed" ~:
 220 --                      ["--unknown1", "--unknown2"] ~=? unkFlags,
 221 --                 "getOpt errors" ~: "failed" ~: [] ~=? ers],
 222 --
 223 --               TestLabel "test location of various compilers" $ TestList
 224 --               ["configure parsing for prefix and compiler flag" ~: "failed" ~:
 225 --                    (Right (ConfigCmd (Just comp, Nothing, Just "/usr/local"), []))
 226 --                   ~=? (parseArgs ["--prefix=/usr/local", "--"++name, "configure"])
 227 --                   | (name, comp) <- m],
 228 --
 229 --               TestLabel "find the package tool" $ TestList
 230 --               ["configure parsing for prefix comp flag, withcompiler" ~: "failed" ~:
 231 --                    (Right (ConfigCmd (Just comp, Just "/foo/comp", Just "/usr/local"), []))
 232 --                   ~=? (parseArgs ["--prefix=/usr/local", "--"++name,
 233 --                                   "--with-compiler=/foo/comp", "configure"])
 234 --                   | (name, comp) <- m],
 235 --
 236 --               TestLabel "simpler commands" $ TestList
 237 --               [flag ~: "failed" ~: (Right (flagCmd, [])) ~=? (parseArgs [flag])
 238 --                   | (flag, flagCmd) <- [("build", BuildCmd),
 239 --                                         ("install", InstallCmd Nothing False),
 240 --                                         ("sdist", SDistCmd),
 241 --                                         ("register", RegisterCmd False)]
 242 --                  ]
 243 --               ]
 244
 245 {- Testing ideas:
 246    * IO to look for hugs and hugs-pkg (which hugs, etc)
 247    * quickCheck to test permutations of arguments
 248    * what other options can we over-ride with a command-line flag?
 249 -}
 250
 251 instance Binary BuildingWhat
 252 instance Structured BuildingWhat