Cabal/Distribution/PackageDescription/Parsec/FieldDescr.hs

   1 {-# LANGUAGE OverloadedStrings #-}
   2 -- | 'GenericPackageDescription' Field descriptions
   3 module Distribution.PackageDescription.Parsec.FieldDescr (
   4     -- * Package description
   5     pkgDescrFieldDescrs,
   6     storeXFieldsPD,
   7     -- * Library
   8     libFieldDescrs,
   9     storeXFieldsLib,
  10     -- * Foreign library
  11     foreignLibFieldDescrs,
  12     storeXFieldsForeignLib,
  13     -- * Executable
  14     executableFieldDescrs,
  15     storeXFieldsExe,
  16     -- * Test suite
  17     TestSuiteStanza (..),
  18     emptyTestStanza,
  19     testSuiteFieldDescrs,
  20     storeXFieldsTest,
  21     validateTestSuite,
  22     -- * Benchmark
  23     BenchmarkStanza (..),
  24     emptyBenchmarkStanza,
  25     benchmarkFieldDescrs,
  26     storeXFieldsBenchmark,
  27     validateBenchmark,
  28     -- * Flag
  29     flagFieldDescrs,
  30     -- * Source repository
  31     sourceRepoFieldDescrs,
  32     -- * Setup build info
  33     setupBInfoFieldDescrs,
  34     ) where
  35
  36 import           Prelude ()
  37 import           Distribution.Compat.Prelude
  38 import qualified Data.ByteString                       as BS
  39 import           Data.List                             (dropWhileEnd)
  40 import qualified Distribution.Compat.Parsec            as Parsec
  41 import           Distribution.Compiler                 (CompilerFlavor (..))
  42 import           Distribution.ModuleName               (ModuleName)
  43 import           Distribution.Package
  44 import           Distribution.PackageDescription
  45 import           Distribution.Types.ForeignLib
  46 import           Distribution.Parsec.Class
  47 import           Distribution.Parsec.Types.Common
  48 import           Distribution.Parsec.Types.FieldDescr
  49 import           Distribution.Parsec.Types.ParseResult
  50 import           Distribution.PrettyUtils
  51 import           Distribution.Simple.Utils             (fromUTF8BS)
  52 import           Distribution.Text                     (disp, display)
  53 import           Text.PrettyPrint                      (vcat)
  54
  55 -------------------------------------------------------------------------------
  56 -- common FieldParsers
  57 -------------------------------------------------------------------------------
  58
  59 -- | This is /almost/ @'many' 'Distribution.Compat.Parsec.anyChar'@, but it
  60 --
  61 -- * trims whitespace from ends of the lines,
  62 --
  63 -- * converts lines with only single dot into empty line.
  64 --
  65 freeTextFieldParser :: FieldParser String
  66 freeTextFieldParser = dropDotLines <$ Parsec.spaces <*> many Parsec.anyChar
  67   where
  68     -- Example package with dot lines
  69     -- http://hackage.haskell.org/package/copilot-cbmc-0.1/copilot-cbmc.cabal
  70     dropDotLines "." = "."
  71     dropDotLines x = intercalate "\n" . map dotToEmpty . lines $ x
  72     dotToEmpty x | trim' x == "." = ""
  73     dotToEmpty x                  = trim x
  74
  75     trim' = dropWhileEnd (`elem` (" \t" :: String))
  76
  77 -------------------------------------------------------------------------------
  78 -- PackageDescription
  79 -------------------------------------------------------------------------------
  80
  81 -- TODO: other-files isn't used in any cabal file on Hackage.
  82 pkgDescrFieldDescrs :: [FieldDescr PackageDescription]
  83 pkgDescrFieldDescrs =
  84     [ simpleField "name"
  85         disp                   parsec
  86         packageName            (\name pkg -> pkg{package=(package pkg){pkgName=name}})
  87     , simpleField "version"
  88         disp                   parsec
  89         packageVersion         (\ver pkg -> pkg{package=(package pkg){pkgVersion=ver}})
  90     , simpleField "cabal-version"
  91              (either disp disp)     (Left <$> parsec <|> Right <$> parsec)
  92              specVersionRaw         (\v pkg -> pkg{specVersionRaw=v})
  93     , simpleField "build-type"
  94              (maybe mempty disp)    (Just <$> parsec)
  95              buildType              (\t pkg -> pkg{buildType=t})
  96     , simpleField "license"
  97              disp                   (parsecMaybeQuoted parsec)
  98              license                (\l pkg -> pkg{license=l})
  99     , simpleField "license-file"
 100              showFilePath           parsecFilePath
 101              (\pkg -> case licenseFiles pkg of
 102                         [x] -> x
 103                         _   -> "")
 104              (\l pkg -> pkg{licenseFiles=licenseFiles pkg ++ [l]})
 105      -- We have both 'license-file' and 'license-files' fields.
 106      -- Rather than declaring license-file to be deprecated, we will continue
 107      -- to allow both. The 'license-file' will continue to only allow single
 108      -- tokens, while 'license-files' allows multiple. On pretty-printing, we
 109      -- will use 'license-file' if there's just one, and use 'license-files'
 110      -- otherwise.
 111    , listField "license-files"
 112              showFilePath          parsecFilePath
 113              (\pkg -> case licenseFiles pkg of
 114                         [_] -> []
 115                         xs  -> xs)
 116              (\ls pkg -> pkg{licenseFiles=ls})
 117    , simpleField "copyright"
 118              showFreeText           freeTextFieldParser
 119              copyright              (\val pkg -> pkg{copyright=val})
 120    , simpleField "maintainer"
 121              showFreeText           freeTextFieldParser
 122              maintainer             (\val pkg -> pkg{maintainer=val})
 123    , simpleField "stability"
 124              showFreeText           freeTextFieldParser
 125              stability              (\val pkg -> pkg{stability=val})
 126    , simpleField "homepage"
 127              showFreeText           freeTextFieldParser
 128              homepage               (\val pkg -> pkg{homepage=val})
 129    , simpleField "package-url"
 130              showFreeText           freeTextFieldParser
 131              pkgUrl                 (\val pkg -> pkg{pkgUrl=val})
 132    , simpleField "bug-reports"
 133              showFreeText           freeTextFieldParser
 134              bugReports             (\val pkg -> pkg{bugReports=val})
 135    , simpleField "synopsis"
 136              showFreeText           freeTextFieldParser
 137              synopsis               (\val pkg -> pkg{synopsis=val})
 138    , simpleField "description"
 139              showFreeText           freeTextFieldParser
 140              description            (\val pkg -> pkg{description=val})
 141    , simpleField "category"
 142              showFreeText           freeTextFieldParser
 143              category               (\val pkg -> pkg{category=val})
 144    , simpleField "author"
 145              showFreeText           freeTextFieldParser
 146              author                 (\val pkg -> pkg{author=val})
 147    , listField "tested-with"
 148              showTestedWith         parsecTestedWith
 149              testedWith             (\val pkg -> pkg{testedWith=val})
 150    , listFieldWithSep vcat "data-files"
 151              showFilePath           parsecFilePath
 152              dataFiles              (\val pkg -> pkg{dataFiles=val})
 153    , simpleField "data-dir"
 154              showFilePath           parsecFilePath
 155              dataDir                (\val pkg -> pkg{dataDir=val})
 156    , listFieldWithSep vcat "extra-source-files"
 157              showFilePath           parsecFilePath
 158              extraSrcFiles          (\val pkg -> pkg{extraSrcFiles=val})
 159    , listFieldWithSep vcat "extra-tmp-files"
 160              showFilePath           parsecFilePath
 161              extraTmpFiles          (\val pkg -> pkg{extraTmpFiles=val})
 162    , listFieldWithSep vcat "extra-doc-files"
 163              showFilePath           parsecFilePath
 164              extraDocFiles          (\val pkg -> pkg{extraDocFiles=val})
 165    ]
 166
 167 -- | Store any fields beginning with "x-" in the customFields field of
 168 --   a PackageDescription.  All other fields will generate a warning.
 169 storeXFieldsPD :: UnknownFieldParser PackageDescription
 170 storeXFieldsPD f val pkg | beginsWithX f =
 171     Just pkg { customFieldsPD = customFieldsPD pkg ++ [(fromUTF8BS f, trim val)] }
 172 storeXFieldsPD _ _ _ = Nothing
 173
 174 -------------------------------------------------------------------------------
 175 -- Library
 176 -------------------------------------------------------------------------------
 177
 178 libFieldDescrs :: [FieldDescr Library]
 179 libFieldDescrs =
 180     [ listFieldWithSep vcat "exposed-modules" disp (parsecMaybeQuoted parsec)
 181         exposedModules (\mods lib -> lib{exposedModules=mods})
 182     , commaListFieldWithSep vcat "reexported-modules" disp parsec
 183         reexportedModules (\mods lib -> lib{reexportedModules=mods})
 184
 185   , listFieldWithSep vcat "signatures" disp (parsecMaybeQuoted parsec)
 186       signatures (\mods lib -> lib{signatures=mods})
 187
 188     , boolField "exposed"
 189         libExposed     (\val lib -> lib{libExposed=val})
 190     ] ++ map biToLib binfoFieldDescrs
 191   where
 192     biToLib = liftField libBuildInfo (\bi lib -> lib{libBuildInfo=bi})
 193
 194 storeXFieldsLib :: UnknownFieldParser Library
 195 storeXFieldsLib f val l@Library { libBuildInfo = bi } | beginsWithX f =
 196     Just $ l {libBuildInfo =
 197                  bi{ customFieldsBI = customFieldsBI bi ++ [(fromUTF8BS f, trim val)]}}
 198 storeXFieldsLib _ _ _ = Nothing
 199
 200 -------------------------------------------------------------------------------
 201 -- Foreign library
 202 -------------------------------------------------------------------------------
 203
 204 foreignLibFieldDescrs :: [FieldDescr ForeignLib]
 205 foreignLibFieldDescrs =
 206     [ simpleField "type"
 207       disp                   parsec
 208       foreignLibType         (\x flib -> flib { foreignLibType = x })
 209     , listField "options"
 210       disp                   parsec
 211       foreignLibOptions      (\x flib -> flib { foreignLibOptions = x })
 212     , simpleField "lib-version-info"
 213       (maybe mempty disp)    (Just <$> parsec)
 214       foreignLibVersionInfo   (\x flib -> flib { foreignLibVersionInfo = x })
 215     , simpleField "lib-version-linux"
 216       (maybe mempty disp)    (Just <$> parsec)
 217       foreignLibVersionLinux  (\x flib -> flib { foreignLibVersionLinux = x })
 218     , listField "mod-def-file"
 219       showFilePath           parsecFilePath
 220       foreignLibModDefFile   (\x flib -> flib { foreignLibModDefFile = x })
 221     ] ++ map biToFLib binfoFieldDescrs
 222   where
 223     biToFLib = liftField foreignLibBuildInfo (\bi flib -> flib{foreignLibBuildInfo=bi})
 224
 225 storeXFieldsForeignLib :: UnknownFieldParser ForeignLib
 226 storeXFieldsForeignLib f val l@ForeignLib { foreignLibBuildInfo = bi } | beginsWithX f =
 227     Just $ l {foreignLibBuildInfo =
 228                  bi{ customFieldsBI = customFieldsBI bi ++ [(fromUTF8BS f, trim val)]}}
 229 storeXFieldsForeignLib _ _ _ = Nothing
 230
 231 -------------------------------------------------------------------------------
 232 -- Executable
 233 -------------------------------------------------------------------------------
 234
 235 executableFieldDescrs :: [FieldDescr Executable]
 236 executableFieldDescrs =
 237     [ -- note ordering: configuration must come first, for
 238       -- showPackageDescription.
 239       simpleField "executable"
 240         disp               parsec
 241         exeName            (\xs    exe -> exe{exeName=xs})
 242     , simpleField "main-is"
 243         showFilePath       parsecFilePath
 244         modulePath         (\xs    exe -> exe{modulePath=xs})
 245     ]
 246     ++ map biToExe binfoFieldDescrs
 247   where
 248     biToExe = liftField buildInfo (\bi exe -> exe{buildInfo=bi})
 249
 250 storeXFieldsExe :: UnknownFieldParser Executable
 251 storeXFieldsExe f val e@Executable { buildInfo = bi } | beginsWithX f =
 252     Just $ e {buildInfo = bi{ customFieldsBI = (fromUTF8BS f, trim val) : customFieldsBI bi}}
 253 storeXFieldsExe _ _ _ = Nothing
 254
 255 -------------------------------------------------------------------------------
 256 -- TestSuite
 257 -------------------------------------------------------------------------------
 258
 259 -- | An intermediate type just used for parsing the test-suite stanza.
 260 -- After validation it is converted into the proper 'TestSuite' type.
 261 data TestSuiteStanza = TestSuiteStanza
 262     { testStanzaTestType   :: Maybe TestType
 263     , testStanzaMainIs     :: Maybe FilePath
 264     , testStanzaTestModule :: Maybe ModuleName
 265     , testStanzaBuildInfo  :: BuildInfo
 266     }
 267
 268 emptyTestStanza :: TestSuiteStanza
 269 emptyTestStanza = TestSuiteStanza Nothing Nothing Nothing mempty
 270
 271 testSuiteFieldDescrs :: [FieldDescr TestSuiteStanza]
 272 testSuiteFieldDescrs =
 273     [ simpleField "type"
 274         (maybe mempty disp)   (Just <$> parsec)
 275         testStanzaTestType    (\x suite -> suite { testStanzaTestType = x })
 276     , simpleField "main-is"
 277         (maybe mempty showFilePath) (Just <$> parsecFilePath)
 278         testStanzaMainIs      (\x suite -> suite { testStanzaMainIs = x })
 279     , simpleField "test-module"
 280         (maybe mempty disp)   (Just <$> parsecMaybeQuoted parsec)
 281         testStanzaTestModule  (\x suite -> suite { testStanzaTestModule = x })
 282     ]
 283     ++ map biToTest binfoFieldDescrs
 284   where
 285     biToTest = liftField
 286         testStanzaBuildInfo
 287         (\bi suite -> suite { testStanzaBuildInfo = bi })
 288
 289 storeXFieldsTest :: UnknownFieldParser TestSuiteStanza
 290 storeXFieldsTest f val t@TestSuiteStanza { testStanzaBuildInfo = bi }
 291     | beginsWithX f =
 292         Just $ t {testStanzaBuildInfo = bi{ customFieldsBI = (fromUTF8BS f,val):customFieldsBI bi}}
 293 storeXFieldsTest _ _ _ = Nothing
 294
 295 validateTestSuite :: Position -> TestSuiteStanza -> ParseResult TestSuite
 296 validateTestSuite pos stanza = case testStanzaTestType stanza of
 297     Nothing -> return $
 298         emptyTestSuite { testBuildInfo = testStanzaBuildInfo stanza }
 299
 300     Just tt@(TestTypeUnknown _ _) ->
 301         pure emptyTestSuite
 302             { testInterface = TestSuiteUnsupported tt
 303             , testBuildInfo = testStanzaBuildInfo stanza
 304             }
 305
 306     Just tt | tt `notElem` knownTestTypes ->
 307         pure emptyTestSuite
 308             { testInterface = TestSuiteUnsupported tt
 309             , testBuildInfo = testStanzaBuildInfo stanza
 310             }
 311
 312     Just tt@(TestTypeExe ver) -> case testStanzaMainIs stanza of
 313         Nothing   -> do
 314             parseFailure pos (missingField "main-is" tt)
 315             pure emptyTestSuite
 316         Just file -> do
 317             when (isJust (testStanzaTestModule stanza)) $
 318                 parseWarning pos PWTExtraBenchmarkModule (extraField "test-module" tt)
 319             pure emptyTestSuite
 320                 { testInterface = TestSuiteExeV10 ver file
 321                 , testBuildInfo = testStanzaBuildInfo stanza
 322                 }
 323
 324     Just tt@(TestTypeLib ver) -> case testStanzaTestModule stanza of
 325          Nothing      -> do
 326              parseFailure pos (missingField "test-module" tt)
 327              pure emptyTestSuite
 328          Just module_ -> do
 329             when (isJust (testStanzaMainIs stanza)) $
 330                 parseWarning pos PWTExtraMainIs (extraField "main-is" tt)
 331             pure emptyTestSuite
 332                 { testInterface = TestSuiteLibV09 ver module_
 333                 , testBuildInfo = testStanzaBuildInfo stanza
 334                 }
 335
 336   where
 337     missingField name tt = "The '" ++ name ++ "' field is required for the "
 338                         ++ display tt ++ " test suite type."
 339
 340     extraField   name tt = "The '" ++ name ++ "' field is not used for the '"
 341                         ++ display tt ++ "' test suite type."
 342
 343 -------------------------------------------------------------------------------
 344 -- Benchmark
 345 -------------------------------------------------------------------------------
 346
 347 -- | An intermediate type just used for parsing the benchmark stanza.
 348 -- After validation it is converted into the proper 'Benchmark' type.
 349 data BenchmarkStanza = BenchmarkStanza
 350     { benchmarkStanzaBenchmarkType   :: Maybe BenchmarkType
 351     , benchmarkStanzaMainIs          :: Maybe FilePath
 352     , benchmarkStanzaBenchmarkModule :: Maybe ModuleName
 353     , benchmarkStanzaBuildInfo        :: BuildInfo
 354     }
 355
 356 emptyBenchmarkStanza :: BenchmarkStanza
 357 emptyBenchmarkStanza = BenchmarkStanza Nothing Nothing Nothing mempty
 358
 359 benchmarkFieldDescrs :: [FieldDescr BenchmarkStanza]
 360 benchmarkFieldDescrs =
 361     [ simpleField "type"
 362         (maybe mempty disp)    (Just <$> parsec)
 363         benchmarkStanzaBenchmarkType
 364         (\x suite -> suite { benchmarkStanzaBenchmarkType = x })
 365     , simpleField "main-is"
 366         (maybe mempty showFilePath)  (Just <$> parsecFilePath)
 367         benchmarkStanzaMainIs
 368         (\x suite -> suite { benchmarkStanzaMainIs = x })
 369     ]
 370     ++ map biToBenchmark binfoFieldDescrs
 371   where
 372     biToBenchmark = liftField benchmarkStanzaBuildInfo
 373                     (\bi suite -> suite { benchmarkStanzaBuildInfo = bi })
 374
 375 storeXFieldsBenchmark :: UnknownFieldParser BenchmarkStanza
 376 storeXFieldsBenchmark f val t@BenchmarkStanza { benchmarkStanzaBuildInfo = bi } | beginsWithX f =
 377     Just $ t {benchmarkStanzaBuildInfo =
 378                        bi{ customFieldsBI = (fromUTF8BS f, trim val):customFieldsBI bi}}
 379 storeXFieldsBenchmark _ _ _ = Nothing
 380
 381 validateBenchmark :: Position -> BenchmarkStanza -> ParseResult Benchmark
 382 validateBenchmark pos stanza = case benchmarkStanzaBenchmarkType stanza of
 383     Nothing -> pure emptyBenchmark
 384         { benchmarkBuildInfo = benchmarkStanzaBuildInfo stanza }
 385
 386     Just tt@(BenchmarkTypeUnknown _ _) -> pure emptyBenchmark
 387         { benchmarkInterface = BenchmarkUnsupported tt
 388         , benchmarkBuildInfo = benchmarkStanzaBuildInfo stanza
 389         }
 390
 391     Just tt | tt `notElem` knownBenchmarkTypes -> pure emptyBenchmark
 392         { benchmarkInterface = BenchmarkUnsupported tt
 393         , benchmarkBuildInfo = benchmarkStanzaBuildInfo stanza
 394         }
 395
 396     Just tt@(BenchmarkTypeExe ver) -> case benchmarkStanzaMainIs stanza of
 397         Nothing   -> do
 398             parseFailure pos (missingField "main-is" tt)
 399             pure emptyBenchmark
 400         Just file -> do
 401             when (isJust (benchmarkStanzaBenchmarkModule stanza)) $
 402                 parseWarning pos PWTExtraBenchmarkModule (extraField "benchmark-module" tt)
 403             pure emptyBenchmark
 404                 { benchmarkInterface = BenchmarkExeV10 ver file
 405                 , benchmarkBuildInfo = benchmarkStanzaBuildInfo stanza
 406                 }
 407
 408   where
 409     missingField name tt = "The '" ++ name ++ "' field is required for the "
 410                         ++ display tt ++ " benchmark type."
 411
 412     extraField   name tt = "The '" ++ name ++ "' field is not used for the '"
 413                         ++ display tt ++ "' benchmark type."
 414
 415 -------------------------------------------------------------------------------
 416 -- BuildInfo
 417 -------------------------------------------------------------------------------
 418
 419 binfoFieldDescrs :: [FieldDescr BuildInfo]
 420 binfoFieldDescrs =
 421  [ boolField "buildable"
 422            buildable          (\val binfo -> binfo{buildable=val})
 423  , commaListField  "build-tools"
 424            disp               parsec
 425            buildTools         (\xs  binfo -> binfo{buildTools=xs})
 426  , commaListField  "build-tool-depends"
 427            disp               parsec
 428            buildToolDepends   (\xs  binfo -> binfo{buildToolDepends=xs})
 429  , commaListFieldWithSep vcat "build-depends"
 430        disp               parsec
 431        targetBuildDepends (\xs binfo -> binfo{targetBuildDepends=xs})
 432  , commaListFieldWithSep vcat "mixins"
 433        disp               parsec
 434        mixins (\xs binfo -> binfo{mixins=xs})
 435  , spaceListField "cpp-options"
 436            showToken          parsecToken'
 437            cppOptions          (\val binfo -> binfo{cppOptions=val})
 438  , spaceListField "cc-options"
 439            showToken          parsecToken'
 440            ccOptions          (\val binfo -> binfo{ccOptions=val})
 441  , spaceListField "ld-options"
 442            showToken          parsecToken'
 443            ldOptions          (\val binfo -> binfo{ldOptions=val})
 444  , commaListField  "pkgconfig-depends"
 445            disp               parsec
 446            pkgconfigDepends   (\xs  binfo -> binfo{pkgconfigDepends=xs})
 447  , listField "frameworks"
 448            showToken          parsecToken
 449            frameworks         (\val binfo -> binfo{frameworks=val})
 450  , listField "extra-framework-dirs"
 451            showToken          parsecFilePath
 452            extraFrameworkDirs (\val binfo -> binfo{extraFrameworkDirs=val})
 453  , listFieldWithSep vcat "c-sources"
 454            showFilePath       parsecFilePath
 455            cSources           (\paths binfo -> binfo{cSources=paths})
 456  , listFieldWithSep vcat "js-sources"
 457            showFilePath       parsecFilePath
 458            jsSources          (\paths binfo -> binfo{jsSources=paths})
 459    , simpleField "default-language"
 460        (maybe mempty disp) (Parsec.optionMaybe $ parsecMaybeQuoted parsec)
 461         defaultLanguage    (\lang  binfo -> binfo{defaultLanguage=lang})
 462  , listField   "other-languages"
 463            disp              (parsecMaybeQuoted parsec)
 464            otherLanguages     (\langs binfo -> binfo{otherLanguages=langs})
 465    , listField   "default-extensions"
 466        disp               (parsecMaybeQuoted parsec)
 467        defaultExtensions  (\exts  binfo -> binfo{defaultExtensions=exts})
 468    , listField   "other-extensions"
 469        disp               (parsecMaybeQuoted parsec)
 470        otherExtensions    (\exts  binfo -> binfo{otherExtensions=exts})
 471    , listField   "extensions"
 472        -- TODO: this is deprecated field, isn't it?
 473        disp               (parsecMaybeQuoted parsec)
 474        oldExtensions      (\exts  binfo -> binfo{oldExtensions=exts})
 475  , listFieldWithSep vcat "extra-libraries"
 476            showToken          parsecToken
 477            extraLibs          (\xs    binfo -> binfo{extraLibs=xs})
 478  , listFieldWithSep vcat "extra-ghci-libraries"
 479            showToken          parsecToken
 480            extraGHCiLibs      (\xs    binfo -> binfo{extraGHCiLibs=xs})
 481  , listField   "extra-lib-dirs"
 482            showFilePath       parsecFilePath
 483            extraLibDirs       (\xs    binfo -> binfo{extraLibDirs=xs})
 484  , listFieldWithSep vcat "includes"
 485            showFilePath       parsecFilePath
 486            includes           (\paths binfo -> binfo{includes=paths})
 487  , listFieldWithSep vcat "install-includes"
 488            showFilePath       parsecFilePath
 489            installIncludes    (\paths binfo -> binfo{installIncludes=paths})
 490  , listField   "include-dirs"
 491            showFilePath       parsecFilePath
 492            includeDirs        (\paths binfo -> binfo{includeDirs=paths})
 493    , listField   "hs-source-dirs"
 494        showFilePath        parsecFilePath
 495        hsSourceDirs       (\paths binfo -> binfo{hsSourceDirs=paths})
 496    , deprecatedField "hs-source-dirs" $ listField  "hs-source-dir"
 497        showFilePath        parsecFilePath
 498        (const [])          (\paths binfo -> binfo{hsSourceDirs=paths})
 499    , listFieldWithSep vcat "other-modules"
 500        disp               (parsecMaybeQuoted parsec)
 501        otherModules       (\val binfo -> binfo{otherModules=val})
 502    , listFieldWithSep vcat "autogen-modules"
 503        disp               (parsecMaybeQuoted parsec)
 504        autogenModules     (\val binfo -> binfo{autogenModules=val})
 505  , optsField   "ghc-prof-options" GHC
 506            profOptions        (\val binfo -> binfo{profOptions=val})
 507  , optsField   "ghcjs-prof-options" GHCJS
 508            profOptions        (\val binfo -> binfo{profOptions=val})
 509  , optsField   "ghc-shared-options" GHC
 510            sharedOptions      (\val binfo -> binfo{sharedOptions=val})
 511  , optsField   "ghcjs-shared-options" GHCJS
 512            sharedOptions      (\val binfo -> binfo{sharedOptions=val})
 513    , optsField   "ghc-options"  GHC
 514         options            (\path  binfo -> binfo{options=path})
 515  , optsField   "ghcjs-options" GHCJS
 516            options            (\path  binfo -> binfo{options=path})
 517  , optsField   "jhc-options"  JHC
 518            options            (\path  binfo -> binfo{options=path})
 519  -- NOTE: Hugs and NHC are not supported anymore, but these fields are kept
 520  -- around for backwards compatibility.
 521  --
 522  -- TODO: deprecate?
 523  , optsField   "hugs-options" Hugs
 524            options            (const id)
 525  , optsField   "nhc98-options" NHC
 526            options            (const id)
 527    ]
 528
 529 {-
 530 storeXFieldsBI :: UnknownFieldParser BuildInfo
 531 --storeXFieldsBI (f@('x':'-':_),val) bi = Just bi{ customFieldsBI = (f,val):customFieldsBI bi }
 532 storeXFieldsBI _ _ = Nothing
 533 -}
 534
 535 -------------------------------------------------------------------------------
 536 -- Flag
 537 -------------------------------------------------------------------------------
 538
 539 flagFieldDescrs :: [FieldDescr Flag]
 540 flagFieldDescrs =
 541     [ simpleField "description"
 542         showFreeText     freeTextFieldParser
 543         flagDescription  (\val fl -> fl{ flagDescription = val })
 544     , boolField "default"
 545         flagDefault      (\val fl -> fl{ flagDefault = val })
 546     , boolField "manual"
 547         flagManual       (\val fl -> fl{ flagManual = val })
 548     ]
 549
 550 -------------------------------------------------------------------------------
 551 -- SourceRepo
 552 -------------------------------------------------------------------------------
 553
 554 sourceRepoFieldDescrs :: [FieldDescr SourceRepo]
 555 sourceRepoFieldDescrs =
 556     [ simpleField "type"
 557         (maybe mempty disp)         (Just <$> parsec)
 558         repoType                    (\val repo -> repo { repoType = val })
 559     , simpleField "location"
 560         (maybe mempty showFreeText) (Just <$> freeTextFieldParser)
 561         repoLocation                (\val repo -> repo { repoLocation = val })
 562     , simpleField "module"
 563         (maybe mempty showToken)    (Just <$> parsecToken)
 564         repoModule                  (\val repo -> repo { repoModule = val })
 565     , simpleField "branch"
 566         (maybe mempty showToken)    (Just <$> parsecToken)
 567         repoBranch                  (\val repo -> repo { repoBranch = val })
 568     , simpleField "tag"
 569         (maybe mempty showToken)    (Just <$> parsecToken)
 570         repoTag                     (\val repo -> repo { repoTag = val })
 571     , simpleField "subdir"
 572         (maybe mempty showFilePath) (Just <$> parsecFilePath)
 573         repoSubdir                  (\val repo -> repo { repoSubdir = val })
 574     ]
 575
 576 -------------------------------------------------------------------------------
 577 -- SetupBuildInfo
 578 -------------------------------------------------------------------------------
 579
 580 setupBInfoFieldDescrs :: [FieldDescr SetupBuildInfo]
 581 setupBInfoFieldDescrs =
 582     [ commaListFieldWithSep vcat "setup-depends"
 583         disp         parsec
 584         setupDepends (\xs binfo -> binfo{setupDepends=xs})
 585     ]
 586
 587
 588 -------------------------------------------------------------------------------
 589 -- Utilities
 590 -------------------------------------------------------------------------------
 591
 592 -- | Predicate to test field names beginning with "x-"
 593 beginsWithX :: FieldName -> Bool
 594 beginsWithX bs = BS.take 2 bs == "x-"
 595
 596 -- | Mark the field as deprecated.
 597 deprecatedField
 598     :: FieldName   -- ^ alternative field
 599     -> FieldDescr a
 600     -> FieldDescr a
 601 deprecatedField newFieldName fd = FieldDescr
 602     { fieldName   = oldFieldName
 603     , fieldPretty = const mempty  -- we don't print deprecated field
 604     , fieldParser = \x -> do
 605         parsecWarning PWTDeprecatedField $
 606             "The field " <> show oldFieldName <>
 607             " is deprecated, please use " <> show newFieldName
 608         fieldParser fd x
 609     }
 610   where
 611     oldFieldName = fieldName fd
 612
 613 -- Used to trim x-fields
 614 trim :: String -> String
 615 trim = dropWhile isSpace . dropWhileEnd isSpace