Commit db25db98 authored by Duncan Coutts's avatar Duncan Coutts
Browse files

Move ppField(s) utils into ParseUtils module

and stop exporting various internal stuff from PackageDescription.Parse
which was previously being used by the sanity checking code.
parent 3c9eccfa
......@@ -56,7 +56,7 @@ module Distribution.InstalledPackageInfo (
import Distribution.ParseUtils (
FieldDescr(..), readFields, ParseResult(..), PError(..), PWarning,
Field(F), simpleField, listField, parseLicenseQ,
Field(F), simpleField, listField, parseLicenseQ, ppField, ppFields,
parseFilePathQ, parseTokenQ, parseModuleNameQ, parsePackageNameQ,
showFilePath, showToken, parseReadS, parseOptVersion, parseQuoted,
showFreeText)
......@@ -170,11 +170,7 @@ parseBasicStanza _ _ _ =
-- Pretty-printing
showInstalledPackageInfo :: InstalledPackageInfo -> String
showInstalledPackageInfo pkg = render (ppFields all_fields)
where
ppFields [] = empty
ppFields ((FieldDescr name get' _):flds) =
pprField name (get' pkg) $$ ppFields flds
showInstalledPackageInfo pkg = render (ppFields pkg all_fields)
showInstalledPackageInfoField
:: String
......@@ -182,10 +178,7 @@ showInstalledPackageInfoField
showInstalledPackageInfoField field
= case [ (f,get') | (FieldDescr f get' _) <- all_fields, f == field ] of
[] -> Nothing
((f,get'):_) -> Just (render . pprField f . get')
pprField :: String -> Doc -> Doc
pprField name field = text name <> colon <+> field
((f,get'):_) -> Just (render . ppField f . get')
-- -----------------------------------------------------------------------------
-- Description of the fields, for parsing/printing
......
......@@ -46,13 +46,6 @@ module Distribution.PackageDescription.Parse (
parsePackageDescription,
showPackageDescription,
-- ** Misc internals
reqNameName,
reqNameVersion,
libFieldDescrs,
executableFieldDescrs,
ppFields,
-- ** Parsing
ParseResult(..),
FieldDescr(..),
......@@ -88,25 +81,12 @@ import Distribution.Simple.Utils (die, dieWithLocation, warn)
-- -----------------------------------------------------------------------------
-- The PackageDescription type
-- the strings for the required fields are necessary here, and so we
-- don't repeat ourselves, I name them:
reqNameName :: String
reqNameName = "name"
reqNameVersion :: String
reqNameVersion = "version"
reqNameCopyright :: String
reqNameCopyright = "copyright"
reqNameMaintainer :: String
reqNameMaintainer = "maintainer"
reqNameSynopsis :: String
reqNameSynopsis = "synopsis"
pkgDescrFieldDescrs :: [FieldDescr PackageDescription]
pkgDescrFieldDescrs =
[ simpleField reqNameName
[ simpleField "name"
text parsePackageName
(pkgName . package) (\name pkg -> pkg{package=(package pkg){pkgName=name}})
, simpleField reqNameVersion
, simpleField "version"
(text . showVersion) parseVersion
(pkgVersion . package) (\ver pkg -> pkg{package=(package pkg){pkgVersion=ver}})
, simpleField "cabal-version"
......@@ -121,10 +101,10 @@ pkgDescrFieldDescrs =
, simpleField "license-file"
showFilePath parseFilePathQ
licenseFile (\l pkg -> pkg{licenseFile=l})
, simpleField reqNameCopyright
, simpleField "copyright"
showFreeText (munch (const True))
copyright (\val pkg -> pkg{copyright=val})
, simpleField reqNameMaintainer
, simpleField "maintainer"
showFreeText (munch (const True))
maintainer (\val pkg -> pkg{maintainer=val})
, commaListField "build-depends"
......@@ -139,7 +119,7 @@ pkgDescrFieldDescrs =
, simpleField "package-url"
showFreeText (munch (const True))
pkgUrl (\val pkg -> pkg{pkgUrl=val})
, simpleField reqNameSynopsis
, simpleField "synopsis"
showFreeText (munch (const True))
synopsis (\val pkg -> pkg{synopsis=val})
, simpleField "description"
......@@ -721,14 +701,6 @@ showHookedBuildInfo (mb_lib_bi, ex_bi) = render $
text "executable:" <+> text name $$
ppFields bi binfoFieldDescrs
ppFields :: a -> [FieldDescr a] -> Doc
ppFields _ [] = empty
ppFields pkg' ((FieldDescr name getter _):flds) =
ppField name (getter pkg') $$ ppFields pkg' flds
ppField :: String -> Doc -> Doc
ppField name fielddoc = text name <> colon <+> fielddoc
-- replace all tabs used as indentation with whitespace, also return where
-- tabs were found
findIndentTabs :: String -> [(Int,Int)]
......
......@@ -50,8 +50,8 @@ OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -}
module Distribution.ParseUtils (
LineNo, PError(..), PWarning, locatedErrorMsg, syntaxError, warning,
runP, ParseResult(..), catchParseError, parseFail,
Field(..), fName, lineNo,
FieldDescr(..), readFields,
Field(..), fName, lineNo,
FieldDescr(..), ppField, ppFields, readFields,
parseFilePathQ, parseTokenQ,
parseModuleNameQ, parseDependency, parseBuildTool, parsePkgconfigDependency,
parseOptVersion, parsePackageNameQ, parseVersionRangeQ,
......@@ -195,6 +195,14 @@ optsField name flavor get set =
| f == f' = (f, opts ++ opts') : rest
| otherwise = (f',opts') : update f opts rest
ppFields :: a -> [FieldDescr a] -> Doc
ppFields _ [] = empty
ppFields pkg' ((FieldDescr name getter _):flds) =
ppField name (getter pkg') $$ ppFields pkg' flds
ppField :: String -> Doc -> Doc
ppField name fielddoc = text name <> colon <+> fielddoc
------------------------------------------------------------------------------
-- The data type for our three syntactic categories
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment