Cabal-2.0.0.2: Distribution/PackageDescription/Parsec/FieldDescr.hs
{-# LANGUAGE OverloadedStrings #-}
-- | 'GenericPackageDescription' Field descriptions
module Distribution.PackageDescription.Parsec.FieldDescr (
-- * Package description
pkgDescrFieldDescrs,
storeXFieldsPD,
-- * Library
libFieldDescrs,
storeXFieldsLib,
-- * Foreign library
foreignLibFieldDescrs,
storeXFieldsForeignLib,
-- * Executable
executableFieldDescrs,
storeXFieldsExe,
-- * Test suite
TestSuiteStanza (..),
emptyTestStanza,
testSuiteFieldDescrs,
storeXFieldsTest,
validateTestSuite,
-- * Benchmark
BenchmarkStanza (..),
emptyBenchmarkStanza,
benchmarkFieldDescrs,
storeXFieldsBenchmark,
validateBenchmark,
-- * Flag
flagFieldDescrs,
-- * Source repository
sourceRepoFieldDescrs,
-- * Setup build info
setupBInfoFieldDescrs,
) where
import Prelude ()
import Distribution.Compat.Prelude
import qualified Data.ByteString as BS
import Data.List (dropWhileEnd)
import qualified Distribution.Compat.Parsec as Parsec
import Distribution.Compiler (CompilerFlavor (..))
import Distribution.ModuleName (ModuleName)
import Distribution.Package
import Distribution.PackageDescription
import Distribution.Types.ForeignLib
import Distribution.Parsec.Class
import Distribution.Parsec.Types.Common
import Distribution.Parsec.Types.FieldDescr
import Distribution.Parsec.Types.ParseResult
import Distribution.PrettyUtils
import Distribution.Simple.Utils (fromUTF8BS)
import Distribution.Text (disp, display)
import Text.PrettyPrint (vcat)
-------------------------------------------------------------------------------
-- common FieldParsers
-------------------------------------------------------------------------------
-- | This is /almost/ @'many' 'Distribution.Compat.Parsec.anyChar'@, but it
--
-- * trims whitespace from ends of the lines,
--
-- * converts lines with only single dot into empty line.
--
freeTextFieldParser :: FieldParser String
freeTextFieldParser = dropDotLines <$ Parsec.spaces <*> many Parsec.anyChar
where
-- Example package with dot lines
-- http://hackage.haskell.org/package/copilot-cbmc-0.1/copilot-cbmc.cabal
dropDotLines "." = "."
dropDotLines x = intercalate "\n" . map dotToEmpty . lines $ x
dotToEmpty x | trim' x == "." = ""
dotToEmpty x = trim x
trim' = dropWhileEnd (`elem` (" \t" :: String))
-------------------------------------------------------------------------------
-- PackageDescription
-------------------------------------------------------------------------------
-- TODO: other-files isn't used in any cabal file on Hackage.
pkgDescrFieldDescrs :: [FieldDescr PackageDescription]
pkgDescrFieldDescrs =
[ simpleField "name"
disp parsec
packageName (\name pkg -> pkg{package=(package pkg){pkgName=name}})
, simpleField "version"
disp parsec
packageVersion (\ver pkg -> pkg{package=(package pkg){pkgVersion=ver}})
, simpleField "cabal-version"
(either disp disp) (Left <$> parsec <|> Right <$> parsec)
specVersionRaw (\v pkg -> pkg{specVersionRaw=v})
, simpleField "build-type"
(maybe mempty disp) (Just <$> parsec)
buildType (\t pkg -> pkg{buildType=t})
, simpleField "license"
disp (parsecMaybeQuoted parsec)
license (\l pkg -> pkg{license=l})
, simpleField "license-file"
showFilePath parsecFilePath
(\pkg -> case licenseFiles pkg of
[x] -> x
_ -> "")
(\l pkg -> pkg{licenseFiles=licenseFiles pkg ++ [l]})
-- We have both 'license-file' and 'license-files' fields.
-- Rather than declaring license-file to be deprecated, we will continue
-- to allow both. The 'license-file' will continue to only allow single
-- tokens, while 'license-files' allows multiple. On pretty-printing, we
-- will use 'license-file' if there's just one, and use 'license-files'
-- otherwise.
, listField "license-files"
showFilePath parsecFilePath
(\pkg -> case licenseFiles pkg of
[_] -> []
xs -> xs)
(\ls pkg -> pkg{licenseFiles=ls})
, simpleField "copyright"
showFreeText freeTextFieldParser
copyright (\val pkg -> pkg{copyright=val})
, simpleField "maintainer"
showFreeText freeTextFieldParser
maintainer (\val pkg -> pkg{maintainer=val})
, simpleField "stability"
showFreeText freeTextFieldParser
stability (\val pkg -> pkg{stability=val})
, simpleField "homepage"
showFreeText freeTextFieldParser
homepage (\val pkg -> pkg{homepage=val})
, simpleField "package-url"
showFreeText freeTextFieldParser
pkgUrl (\val pkg -> pkg{pkgUrl=val})
, simpleField "bug-reports"
showFreeText freeTextFieldParser
bugReports (\val pkg -> pkg{bugReports=val})
, simpleField "synopsis"
showFreeText freeTextFieldParser
synopsis (\val pkg -> pkg{synopsis=val})
, simpleField "description"
showFreeText freeTextFieldParser
description (\val pkg -> pkg{description=val})
, simpleField "category"
showFreeText freeTextFieldParser
category (\val pkg -> pkg{category=val})
, simpleField "author"
showFreeText freeTextFieldParser
author (\val pkg -> pkg{author=val})
, listField "tested-with"
showTestedWith parsecTestedWith
testedWith (\val pkg -> pkg{testedWith=val})
, listFieldWithSep vcat "data-files"
showFilePath parsecFilePath
dataFiles (\val pkg -> pkg{dataFiles=val})
, simpleField "data-dir"
showFilePath parsecFilePath
dataDir (\val pkg -> pkg{dataDir=val})
, listFieldWithSep vcat "extra-source-files"
showFilePath parsecFilePath
extraSrcFiles (\val pkg -> pkg{extraSrcFiles=val})
, listFieldWithSep vcat "extra-tmp-files"
showFilePath parsecFilePath
extraTmpFiles (\val pkg -> pkg{extraTmpFiles=val})
, listFieldWithSep vcat "extra-doc-files"
showFilePath parsecFilePath
extraDocFiles (\val pkg -> pkg{extraDocFiles=val})
]
-- | Store any fields beginning with "x-" in the customFields field of
-- a PackageDescription. All other fields will generate a warning.
storeXFieldsPD :: UnknownFieldParser PackageDescription
storeXFieldsPD f val pkg | beginsWithX f =
Just pkg { customFieldsPD = customFieldsPD pkg ++ [(fromUTF8BS f, trim val)] }
storeXFieldsPD _ _ _ = Nothing
-------------------------------------------------------------------------------
-- Library
-------------------------------------------------------------------------------
libFieldDescrs :: [FieldDescr Library]
libFieldDescrs =
[ listFieldWithSep vcat "exposed-modules" disp (parsecMaybeQuoted parsec)
exposedModules (\mods lib -> lib{exposedModules=mods})
, commaListFieldWithSep vcat "reexported-modules" disp parsec
reexportedModules (\mods lib -> lib{reexportedModules=mods})
, listFieldWithSep vcat "signatures" disp (parsecMaybeQuoted parsec)
signatures (\mods lib -> lib{signatures=mods})
, boolField "exposed"
libExposed (\val lib -> lib{libExposed=val})
] ++ map biToLib binfoFieldDescrs
where
biToLib = liftField libBuildInfo (\bi lib -> lib{libBuildInfo=bi})
storeXFieldsLib :: UnknownFieldParser Library
storeXFieldsLib f val l@Library { libBuildInfo = bi } | beginsWithX f =
Just $ l {libBuildInfo =
bi{ customFieldsBI = customFieldsBI bi ++ [(fromUTF8BS f, trim val)]}}
storeXFieldsLib _ _ _ = Nothing
-------------------------------------------------------------------------------
-- Foreign library
-------------------------------------------------------------------------------
foreignLibFieldDescrs :: [FieldDescr ForeignLib]
foreignLibFieldDescrs =
[ simpleField "type"
disp parsec
foreignLibType (\x flib -> flib { foreignLibType = x })
, listField "options"
disp parsec
foreignLibOptions (\x flib -> flib { foreignLibOptions = x })
, simpleField "lib-version-info"
(maybe mempty disp) (Just <$> parsec)
foreignLibVersionInfo (\x flib -> flib { foreignLibVersionInfo = x })
, simpleField "lib-version-linux"
(maybe mempty disp) (Just <$> parsec)
foreignLibVersionLinux (\x flib -> flib { foreignLibVersionLinux = x })
, listField "mod-def-file"
showFilePath parsecFilePath
foreignLibModDefFile (\x flib -> flib { foreignLibModDefFile = x })
] ++ map biToFLib binfoFieldDescrs
where
biToFLib = liftField foreignLibBuildInfo (\bi flib -> flib{foreignLibBuildInfo=bi})
storeXFieldsForeignLib :: UnknownFieldParser ForeignLib
storeXFieldsForeignLib f val l@ForeignLib { foreignLibBuildInfo = bi } | beginsWithX f =
Just $ l {foreignLibBuildInfo =
bi{ customFieldsBI = customFieldsBI bi ++ [(fromUTF8BS f, trim val)]}}
storeXFieldsForeignLib _ _ _ = Nothing
-------------------------------------------------------------------------------
-- Executable
-------------------------------------------------------------------------------
executableFieldDescrs :: [FieldDescr Executable]
executableFieldDescrs =
[ -- note ordering: configuration must come first, for
-- showPackageDescription.
simpleField "executable"
disp parsec
exeName (\xs exe -> exe{exeName=xs})
, simpleField "main-is"
showFilePath parsecFilePath
modulePath (\xs exe -> exe{modulePath=xs})
, simpleField "scope"
disp parsec
exeScope (\sc exe -> exe{exeScope=sc})
]
++ map biToExe binfoFieldDescrs
where
biToExe = liftField buildInfo (\bi exe -> exe{buildInfo=bi})
storeXFieldsExe :: UnknownFieldParser Executable
storeXFieldsExe f val e@Executable { buildInfo = bi } | beginsWithX f =
Just $ e {buildInfo = bi{ customFieldsBI = (fromUTF8BS f, trim val) : customFieldsBI bi}}
storeXFieldsExe _ _ _ = Nothing
-------------------------------------------------------------------------------
-- TestSuite
-------------------------------------------------------------------------------
-- | An intermediate type just used for parsing the test-suite stanza.
-- After validation it is converted into the proper 'TestSuite' type.
data TestSuiteStanza = TestSuiteStanza
{ testStanzaTestType :: Maybe TestType
, testStanzaMainIs :: Maybe FilePath
, testStanzaTestModule :: Maybe ModuleName
, testStanzaBuildInfo :: BuildInfo
}
emptyTestStanza :: TestSuiteStanza
emptyTestStanza = TestSuiteStanza Nothing Nothing Nothing mempty
testSuiteFieldDescrs :: [FieldDescr TestSuiteStanza]
testSuiteFieldDescrs =
[ simpleField "type"
(maybe mempty disp) (Just <$> parsec)
testStanzaTestType (\x suite -> suite { testStanzaTestType = x })
, simpleField "main-is"
(maybe mempty showFilePath) (Just <$> parsecFilePath)
testStanzaMainIs (\x suite -> suite { testStanzaMainIs = x })
, simpleField "test-module"
(maybe mempty disp) (Just <$> parsecMaybeQuoted parsec)
testStanzaTestModule (\x suite -> suite { testStanzaTestModule = x })
]
++ map biToTest binfoFieldDescrs
where
biToTest = liftField
testStanzaBuildInfo
(\bi suite -> suite { testStanzaBuildInfo = bi })
storeXFieldsTest :: UnknownFieldParser TestSuiteStanza
storeXFieldsTest f val t@TestSuiteStanza { testStanzaBuildInfo = bi }
| beginsWithX f =
Just $ t {testStanzaBuildInfo = bi{ customFieldsBI = (fromUTF8BS f,val):customFieldsBI bi}}
storeXFieldsTest _ _ _ = Nothing
validateTestSuite :: Position -> TestSuiteStanza -> ParseResult TestSuite
validateTestSuite pos stanza = case testStanzaTestType stanza of
Nothing -> return $
emptyTestSuite { testBuildInfo = testStanzaBuildInfo stanza }
Just tt@(TestTypeUnknown _ _) ->
pure emptyTestSuite
{ testInterface = TestSuiteUnsupported tt
, testBuildInfo = testStanzaBuildInfo stanza
}
Just tt | tt `notElem` knownTestTypes ->
pure emptyTestSuite
{ testInterface = TestSuiteUnsupported tt
, testBuildInfo = testStanzaBuildInfo stanza
}
Just tt@(TestTypeExe ver) -> case testStanzaMainIs stanza of
Nothing -> do
parseFailure pos (missingField "main-is" tt)
pure emptyTestSuite
Just file -> do
when (isJust (testStanzaTestModule stanza)) $
parseWarning pos PWTExtraBenchmarkModule (extraField "test-module" tt)
pure emptyTestSuite
{ testInterface = TestSuiteExeV10 ver file
, testBuildInfo = testStanzaBuildInfo stanza
}
Just tt@(TestTypeLib ver) -> case testStanzaTestModule stanza of
Nothing -> do
parseFailure pos (missingField "test-module" tt)
pure emptyTestSuite
Just module_ -> do
when (isJust (testStanzaMainIs stanza)) $
parseWarning pos PWTExtraMainIs (extraField "main-is" tt)
pure emptyTestSuite
{ testInterface = TestSuiteLibV09 ver module_
, testBuildInfo = testStanzaBuildInfo stanza
}
where
missingField name tt = "The '" ++ name ++ "' field is required for the "
++ display tt ++ " test suite type."
extraField name tt = "The '" ++ name ++ "' field is not used for the '"
++ display tt ++ "' test suite type."
-------------------------------------------------------------------------------
-- Benchmark
-------------------------------------------------------------------------------
-- | An intermediate type just used for parsing the benchmark stanza.
-- After validation it is converted into the proper 'Benchmark' type.
data BenchmarkStanza = BenchmarkStanza
{ benchmarkStanzaBenchmarkType :: Maybe BenchmarkType
, benchmarkStanzaMainIs :: Maybe FilePath
, benchmarkStanzaBenchmarkModule :: Maybe ModuleName
, benchmarkStanzaBuildInfo :: BuildInfo
}
emptyBenchmarkStanza :: BenchmarkStanza
emptyBenchmarkStanza = BenchmarkStanza Nothing Nothing Nothing mempty
benchmarkFieldDescrs :: [FieldDescr BenchmarkStanza]
benchmarkFieldDescrs =
[ simpleField "type"
(maybe mempty disp) (Just <$> parsec)
benchmarkStanzaBenchmarkType
(\x suite -> suite { benchmarkStanzaBenchmarkType = x })
, simpleField "main-is"
(maybe mempty showFilePath) (Just <$> parsecFilePath)
benchmarkStanzaMainIs
(\x suite -> suite { benchmarkStanzaMainIs = x })
]
++ map biToBenchmark binfoFieldDescrs
where
biToBenchmark = liftField benchmarkStanzaBuildInfo
(\bi suite -> suite { benchmarkStanzaBuildInfo = bi })
storeXFieldsBenchmark :: UnknownFieldParser BenchmarkStanza
storeXFieldsBenchmark f val t@BenchmarkStanza { benchmarkStanzaBuildInfo = bi } | beginsWithX f =
Just $ t {benchmarkStanzaBuildInfo =
bi{ customFieldsBI = (fromUTF8BS f, trim val):customFieldsBI bi}}
storeXFieldsBenchmark _ _ _ = Nothing
validateBenchmark :: Position -> BenchmarkStanza -> ParseResult Benchmark
validateBenchmark pos stanza = case benchmarkStanzaBenchmarkType stanza of
Nothing -> pure emptyBenchmark
{ benchmarkBuildInfo = benchmarkStanzaBuildInfo stanza }
Just tt@(BenchmarkTypeUnknown _ _) -> pure emptyBenchmark
{ benchmarkInterface = BenchmarkUnsupported tt
, benchmarkBuildInfo = benchmarkStanzaBuildInfo stanza
}
Just tt | tt `notElem` knownBenchmarkTypes -> pure emptyBenchmark
{ benchmarkInterface = BenchmarkUnsupported tt
, benchmarkBuildInfo = benchmarkStanzaBuildInfo stanza
}
Just tt@(BenchmarkTypeExe ver) -> case benchmarkStanzaMainIs stanza of
Nothing -> do
parseFailure pos (missingField "main-is" tt)
pure emptyBenchmark
Just file -> do
when (isJust (benchmarkStanzaBenchmarkModule stanza)) $
parseWarning pos PWTExtraBenchmarkModule (extraField "benchmark-module" tt)
pure emptyBenchmark
{ benchmarkInterface = BenchmarkExeV10 ver file
, benchmarkBuildInfo = benchmarkStanzaBuildInfo stanza
}
where
missingField name tt = "The '" ++ name ++ "' field is required for the "
++ display tt ++ " benchmark type."
extraField name tt = "The '" ++ name ++ "' field is not used for the '"
++ display tt ++ "' benchmark type."
-------------------------------------------------------------------------------
-- BuildInfo
-------------------------------------------------------------------------------
binfoFieldDescrs :: [FieldDescr BuildInfo]
binfoFieldDescrs =
[ boolField "buildable"
buildable (\val binfo -> binfo{buildable=val})
, commaListField "build-tools"
disp parsec
buildTools (\xs binfo -> binfo{buildTools=xs})
, commaListField "build-tool-depends"
disp parsec
buildToolDepends (\xs binfo -> binfo{buildToolDepends=xs})
, commaListFieldWithSep vcat "build-depends"
disp parsec
targetBuildDepends (\xs binfo -> binfo{targetBuildDepends=xs})
, commaListFieldWithSep vcat "mixins"
disp parsec
mixins (\xs binfo -> binfo{mixins=xs})
, spaceListField "cpp-options"
showToken parsecToken'
cppOptions (\val binfo -> binfo{cppOptions=val})
, spaceListField "cc-options"
showToken parsecToken'
ccOptions (\val binfo -> binfo{ccOptions=val})
, spaceListField "ld-options"
showToken parsecToken'
ldOptions (\val binfo -> binfo{ldOptions=val})
, commaListField "pkgconfig-depends"
disp parsec
pkgconfigDepends (\xs binfo -> binfo{pkgconfigDepends=xs})
, listField "frameworks"
showToken parsecToken
frameworks (\val binfo -> binfo{frameworks=val})
, listField "extra-framework-dirs"
showToken parsecFilePath
extraFrameworkDirs (\val binfo -> binfo{extraFrameworkDirs=val})
, listFieldWithSep vcat "c-sources"
showFilePath parsecFilePath
cSources (\paths binfo -> binfo{cSources=paths})
, listFieldWithSep vcat "js-sources"
showFilePath parsecFilePath
jsSources (\paths binfo -> binfo{jsSources=paths})
, simpleField "default-language"
(maybe mempty disp) (Parsec.optionMaybe $ parsecMaybeQuoted parsec)
defaultLanguage (\lang binfo -> binfo{defaultLanguage=lang})
, listField "other-languages"
disp (parsecMaybeQuoted parsec)
otherLanguages (\langs binfo -> binfo{otherLanguages=langs})
, listField "default-extensions"
disp (parsecMaybeQuoted parsec)
defaultExtensions (\exts binfo -> binfo{defaultExtensions=exts})
, listField "other-extensions"
disp (parsecMaybeQuoted parsec)
otherExtensions (\exts binfo -> binfo{otherExtensions=exts})
, listField "extensions"
-- TODO: this is deprecated field, isn't it?
disp (parsecMaybeQuoted parsec)
oldExtensions (\exts binfo -> binfo{oldExtensions=exts})
, listFieldWithSep vcat "extra-libraries"
showToken parsecToken
extraLibs (\xs binfo -> binfo{extraLibs=xs})
, listFieldWithSep vcat "extra-ghci-libraries"
showToken parsecToken
extraGHCiLibs (\xs binfo -> binfo{extraGHCiLibs=xs})
, listField "extra-lib-dirs"
showFilePath parsecFilePath
extraLibDirs (\xs binfo -> binfo{extraLibDirs=xs})
, listFieldWithSep vcat "includes"
showFilePath parsecFilePath
includes (\paths binfo -> binfo{includes=paths})
, listFieldWithSep vcat "install-includes"
showFilePath parsecFilePath
installIncludes (\paths binfo -> binfo{installIncludes=paths})
, listField "include-dirs"
showFilePath parsecFilePath
includeDirs (\paths binfo -> binfo{includeDirs=paths})
, listField "hs-source-dirs"
showFilePath parsecFilePath
hsSourceDirs (\paths binfo -> binfo{hsSourceDirs=paths})
, deprecatedField "hs-source-dirs" $ listField "hs-source-dir"
showFilePath parsecFilePath
(const []) (\paths binfo -> binfo{hsSourceDirs=paths})
, listFieldWithSep vcat "other-modules"
disp (parsecMaybeQuoted parsec)
otherModules (\val binfo -> binfo{otherModules=val})
, listFieldWithSep vcat "autogen-modules"
disp (parsecMaybeQuoted parsec)
autogenModules (\val binfo -> binfo{autogenModules=val})
, optsField "ghc-prof-options" GHC
profOptions (\val binfo -> binfo{profOptions=val})
, optsField "ghcjs-prof-options" GHCJS
profOptions (\val binfo -> binfo{profOptions=val})
, optsField "ghc-shared-options" GHC
sharedOptions (\val binfo -> binfo{sharedOptions=val})
, optsField "ghcjs-shared-options" GHCJS
sharedOptions (\val binfo -> binfo{sharedOptions=val})
, optsField "ghc-options" GHC
options (\path binfo -> binfo{options=path})
, optsField "ghcjs-options" GHCJS
options (\path binfo -> binfo{options=path})
, optsField "jhc-options" JHC
options (\path binfo -> binfo{options=path})
-- NOTE: Hugs and NHC are not supported anymore, but these fields are kept
-- around for backwards compatibility.
--
-- TODO: deprecate?
, optsField "hugs-options" Hugs
options (const id)
, optsField "nhc98-options" NHC
options (const id)
]
{-
storeXFieldsBI :: UnknownFieldParser BuildInfo
--storeXFieldsBI (f@('x':'-':_),val) bi = Just bi{ customFieldsBI = (f,val):customFieldsBI bi }
storeXFieldsBI _ _ = Nothing
-}
-------------------------------------------------------------------------------
-- Flag
-------------------------------------------------------------------------------
flagFieldDescrs :: [FieldDescr Flag]
flagFieldDescrs =
[ simpleField "description"
showFreeText freeTextFieldParser
flagDescription (\val fl -> fl{ flagDescription = val })
, boolField "default"
flagDefault (\val fl -> fl{ flagDefault = val })
, boolField "manual"
flagManual (\val fl -> fl{ flagManual = val })
]
-------------------------------------------------------------------------------
-- SourceRepo
-------------------------------------------------------------------------------
sourceRepoFieldDescrs :: [FieldDescr SourceRepo]
sourceRepoFieldDescrs =
[ simpleField "type"
(maybe mempty disp) (Just <$> parsec)
repoType (\val repo -> repo { repoType = val })
, simpleField "location"
(maybe mempty showFreeText) (Just <$> freeTextFieldParser)
repoLocation (\val repo -> repo { repoLocation = val })
, simpleField "module"
(maybe mempty showToken) (Just <$> parsecToken)
repoModule (\val repo -> repo { repoModule = val })
, simpleField "branch"
(maybe mempty showToken) (Just <$> parsecToken)
repoBranch (\val repo -> repo { repoBranch = val })
, simpleField "tag"
(maybe mempty showToken) (Just <$> parsecToken)
repoTag (\val repo -> repo { repoTag = val })
, simpleField "subdir"
(maybe mempty showFilePath) (Just <$> parsecFilePath)
repoSubdir (\val repo -> repo { repoSubdir = val })
]
-------------------------------------------------------------------------------
-- SetupBuildInfo
-------------------------------------------------------------------------------
setupBInfoFieldDescrs :: [FieldDescr SetupBuildInfo]
setupBInfoFieldDescrs =
[ commaListFieldWithSep vcat "setup-depends"
disp parsec
setupDepends (\xs binfo -> binfo{setupDepends=xs})
]
-------------------------------------------------------------------------------
-- Utilities
-------------------------------------------------------------------------------
-- | Predicate to test field names beginning with "x-"
beginsWithX :: FieldName -> Bool
beginsWithX bs = BS.take 2 bs == "x-"
-- | Mark the field as deprecated.
deprecatedField
:: FieldName -- ^ alternative field
-> FieldDescr a
-> FieldDescr a
deprecatedField newFieldName fd = FieldDescr
{ fieldName = oldFieldName
, fieldPretty = const mempty -- we don't print deprecated field
, fieldParser = \x -> do
parsecWarning PWTDeprecatedField $
"The field " <> show oldFieldName <>
" is deprecated, please use " <> show newFieldName
fieldParser fd x
}
where
oldFieldName = fieldName fd
-- Used to trim x-fields
trim :: String -> String
trim = dropWhile isSpace . dropWhileEnd isSpace