-----------------------------------------------------------------------------
-- |
-- Module      :  Distribution.PackageDescription.Parse
-- Copyright   :  Isaac Jones 2003-2005
--
-- Maintainer  :  cabal-devel@haskell.org
-- Portability :  portable
--
-- This defined parsers and partial pretty printers for the @.cabal@ format.
-- Some of the complexity in this module is due to the fact that we have to be
-- backwards compatible with old @.cabal@ files, so there's code to translate
-- into the newer structure.

{- All rights reserved.

Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions are
met:

    * Redistributions of source code must retain the above copyright
      notice, this list of conditions and the following disclaimer.

    * Redistributions in binary form must reproduce the above
      copyright notice, this list of conditions and the following
      disclaimer in the documentation and/or other materials provided
      with the distribution.

    * Neither the name of Isaac Jones nor the names of other
      contributors may be used to endorse or promote products derived
      from this software without specific prior written permission.

THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -}

module Distribution.PackageDescription.Parse (
        -- * Package descriptions
        readPackageDescription,
        writePackageDescription,
        parsePackageDescription,
        showPackageDescription,

        -- ** Parsing
        ParseResult(..),
        FieldDescr(..),
        LineNo,

        -- ** Supplementary build information
        readHookedBuildInfo,
        parseHookedBuildInfo,
        writeHookedBuildInfo,
        showHookedBuildInfo,

        pkgDescrFieldDescrs,
        libFieldDescrs,
        executableFieldDescrs,
        binfoFieldDescrs,
        sourceRepoFieldDescrs,
        testSuiteFieldDescrs,
        flagFieldDescrs
  ) where

import Data.Char  (isSpace)
import Data.Maybe (listToMaybe, isJust)
import Data.Monoid ( Monoid(..) )
import Data.List  (nub, unfoldr, partition, (\\))
import Control.Monad (liftM, foldM, when, unless)
import System.Directory (doesFileExist)

import Distribution.Text
         ( Text(disp, parse), display, simpleParse )
import Distribution.Compat.ReadP
         ((+++), option)
import Text.PrettyPrint.HughesPJ

import Distribution.ParseUtils hiding (parseFields)
import Distribution.PackageDescription
import Distribution.Package
         ( PackageIdentifier(..), Dependency(..), packageName, packageVersion )
import Distribution.ModuleName ( ModuleName )
import Distribution.Version
        ( Version(Version), orLaterVersion
        , LowerBound(..), asVersionIntervals )
import Distribution.Verbosity (Verbosity)
import Distribution.Compiler  (CompilerFlavor(..))
import Distribution.PackageDescription.Configuration (parseCondition, freeVars)
import Distribution.Simple.Utils
         ( die, dieWithLocation, warn, intercalate, lowercase, cabalVersion
         , withFileContents, withUTF8FileContents
         , writeFileAtomic, writeUTF8File )


-- -----------------------------------------------------------------------------
-- The PackageDescription type

pkgDescrFieldDescrs :: [FieldDescr PackageDescription]
pkgDescrFieldDescrs =
    [ simpleField ::
  String
  -> (a -> Doc)
  -> ReadP a a
  -> (b -> a)
  -> (a -> b -> b)
  -> FieldDescr bsimpleField "name"
           disp :: Text a => a -> Docdisp                   parse :: Text a => forall r. ReadP r aparse
           packageName :: Package pkg => pkg -> PackageNamepackageName            (\name pkg -> pkg :: PackageDescriptionpkg{package=(package :: PackageDescription -> PackageIdentifierpackage pkg :: PackageDescriptionpkg){pkgName=name :: PackageNamename}})
 , simpleField ::
  String
  -> (a -> Doc)
  -> ReadP a a
  -> (b -> a)
  -> (a -> b -> b)
  -> FieldDescr bsimpleField "version"
           disp :: Text a => a -> Docdisp                   parse :: Text a => forall r. ReadP r aparse
           packageVersion :: Package pkg => pkg -> VersionpackageVersion         (\ver pkg -> pkg :: PackageDescriptionpkg{package=(package :: PackageDescription -> PackageIdentifierpackage pkg :: PackageDescriptionpkg){pkgVersion=ver :: Versionver}})
 , simpleField ::
  String
  -> (a -> Doc)
  -> ReadP a a
  -> (b -> a)
  -> (a -> b -> b)
  -> FieldDescr bsimpleField "cabal-version"
           (either :: (a -> c) -> (b -> c) -> Either a b -> ceither disp :: Text a => a -> Docdisp disp :: Text a => a -> Docdisp)     (liftM :: Monad m => (a1 -> r) -> m a1 -> m rliftM Left :: a -> Either a bLeft parse :: Text a => forall r. ReadP r aparse (+++) :: ReadP r a -> ReadP r a -> ReadP r a+++ liftM :: Monad m => (a1 -> r) -> m a1 -> m rliftM Right :: b -> Either a bRight parse :: Text a => forall r. ReadP r aparse)
           specVersionRaw :: PackageDescription -> Either Version VersionRangespecVersionRaw         (\v pkg -> pkg :: PackageDescriptionpkg{specVersionRaw=v :: Stringv})
 , simpleField ::
  String
  -> (a -> Doc)
  -> ReadP a a
  -> (b -> a)
  -> (a -> b -> b)
  -> FieldDescr bsimpleField "build-type"
           (maybe :: b -> (a -> b) -> Maybe a -> bmaybe empty :: Docempty disp :: Text a => a -> Docdisp)     (fmap :: Functor f => forall a b. (a -> b) -> f a -> f bfmap Just :: a -> Maybe aJust parse :: Text a => forall r. ReadP r aparse)
           buildType :: PackageDescription -> Maybe BuildTypebuildType              (\t pkg -> pkg :: PackageDescriptionpkg{buildType=t :: CondTree v c TestSuitet})
 , simpleField ::
  String
  -> (a -> Doc)
  -> ReadP a a
  -> (b -> a)
  -> (a -> b -> b)
  -> FieldDescr bsimpleField "license"
           disp :: Text a => a -> Docdisp                   parseLicenseQ :: ReadP r LicenseparseLicenseQ
           license :: PackageDescription -> Licenselicense                (\l pkg -> pkg :: PackageDescriptionpkg{license=l :: LineNol})
 , simpleField ::
  String
  -> (a -> Doc)
  -> ReadP a a
  -> (b -> a)
  -> (a -> b -> b)
  -> FieldDescr bsimpleField "license-file"
           showFilePath :: FilePath -> DocshowFilePath           parseFilePathQ :: ReadP r FilePathparseFilePathQ
           licenseFile :: PackageDescription -> FilePathlicenseFile            (\l pkg -> pkg :: PackageDescriptionpkg{licenseFile=l :: LineNol})
 , simpleField ::
  String
  -> (a -> Doc)
  -> ReadP a a
  -> (b -> a)
  -> (a -> b -> b)
  -> FieldDescr bsimpleField "copyright"
           showFreeText :: String -> DocshowFreeText           parseFreeText :: ReadP s StringparseFreeText
           copyright :: PackageDescription -> Stringcopyright              (\val pkg -> pkg :: PackageDescriptionpkg{copyright=val :: [FilePath]val})
 , simpleField ::
  String
  -> (a -> Doc)
  -> ReadP a a
  -> (b -> a)
  -> (a -> b -> b)
  -> FieldDescr bsimpleField "maintainer"
           showFreeText :: String -> DocshowFreeText           parseFreeText :: ReadP s StringparseFreeText
           maintainer :: PackageDescription -> Stringmaintainer             (\val pkg -> pkg :: PackageDescriptionpkg{maintainer=val :: [FilePath]val})
 , commaListField ::
  String
  -> (a -> Doc)
  -> ReadP [a] a
  -> (b -> [a])
  -> ([a] -> b -> b)
  -> FieldDescr bcommaListField  "build-depends"
           disp :: Text a => a -> Docdisp                   parse :: Text a => forall r. ReadP r aparse
           buildDepends :: PackageDescription -> [Dependency]buildDepends           (\xs    pkg -> pkg :: PackageDescriptionpkg{buildDepends=xs :: [Dependency]xs})
 , simpleField ::
  String
  -> (a -> Doc)
  -> ReadP a a
  -> (b -> a)
  -> (a -> b -> b)
  -> FieldDescr bsimpleField "stability"
           showFreeText :: String -> DocshowFreeText           parseFreeText :: ReadP s StringparseFreeText
           stability :: PackageDescription -> Stringstability              (\val pkg -> pkg :: PackageDescriptionpkg{stability=val :: [FilePath]val})
 , simpleField ::
  String
  -> (a -> Doc)
  -> ReadP a a
  -> (b -> a)
  -> (a -> b -> b)
  -> FieldDescr bsimpleField "homepage"
           showFreeText :: String -> DocshowFreeText           parseFreeText :: ReadP s StringparseFreeText
           homepage :: PackageDescription -> Stringhomepage               (\val pkg -> pkg :: PackageDescriptionpkg{homepage=val :: [FilePath]val})
 , simpleField ::
  String
  -> (a -> Doc)
  -> ReadP a a
  -> (b -> a)
  -> (a -> b -> b)
  -> FieldDescr bsimpleField "package-url"
           showFreeText :: String -> DocshowFreeText           parseFreeText :: ReadP s StringparseFreeText
           pkgUrl :: PackageDescription -> StringpkgUrl                 (\val pkg -> pkg :: PackageDescriptionpkg{pkgUrl=val :: [FilePath]val})
 , simpleField ::
  String
  -> (a -> Doc)
  -> ReadP a a
  -> (b -> a)
  -> (a -> b -> b)
  -> FieldDescr bsimpleField "bug-reports"
           showFreeText :: String -> DocshowFreeText           parseFreeText :: ReadP s StringparseFreeText
           bugReports :: PackageDescription -> StringbugReports             (\val pkg -> pkg :: PackageDescriptionpkg{bugReports=val :: [FilePath]val})
 , simpleField ::
  String
  -> (a -> Doc)
  -> ReadP a a
  -> (b -> a)
  -> (a -> b -> b)
  -> FieldDescr bsimpleField "synopsis"
           showFreeText :: String -> DocshowFreeText           parseFreeText :: ReadP s StringparseFreeText
           synopsis :: PackageDescription -> Stringsynopsis               (\val pkg -> pkg :: PackageDescriptionpkg{synopsis=val :: [FilePath]val})
 , simpleField ::
  String
  -> (a -> Doc)
  -> ReadP a a
  -> (b -> a)
  -> (a -> b -> b)
  -> FieldDescr bsimpleField "description"
           showFreeText :: String -> DocshowFreeText           parseFreeText :: ReadP s StringparseFreeText
           description :: PackageDescription -> Stringdescription            (\val pkg -> pkg :: PackageDescriptionpkg{description=val :: [FilePath]val})
 , simpleField ::
  String
  -> (a -> Doc)
  -> ReadP a a
  -> (b -> a)
  -> (a -> b -> b)
  -> FieldDescr bsimpleField "category"
           showFreeText :: String -> DocshowFreeText           parseFreeText :: ReadP s StringparseFreeText
           category :: PackageDescription -> Stringcategory               (\val pkg -> pkg :: PackageDescriptionpkg{category=val :: [FilePath]val})
 , simpleField ::
  String
  -> (a -> Doc)
  -> ReadP a a
  -> (b -> a)
  -> (a -> b -> b)
  -> FieldDescr bsimpleField "author"
           showFreeText :: String -> DocshowFreeText           parseFreeText :: ReadP s StringparseFreeText
           author :: PackageDescription -> Stringauthor                 (\val pkg -> pkg :: PackageDescriptionpkg{author=val :: [FilePath]val})
 , listField ::
  String
  -> (a -> Doc)
  -> ReadP [a] a
  -> (b -> [a])
  -> ([a] -> b -> b)
  -> FieldDescr blistField "tested-with"
           showTestedWith :: (CompilerFlavor, VersionRange) -> DocshowTestedWith         parseTestedWithQ :: ReadP r (CompilerFlavor, VersionRange)parseTestedWithQ
           testedWith ::
  PackageDescription -> [(CompilerFlavor, VersionRange)]testedWith             (\val pkg -> pkg :: PackageDescriptionpkg{testedWith=val :: [FilePath]val})
 , listField ::
  String
  -> (a -> Doc)
  -> ReadP [a] a
  -> (b -> [a])
  -> ([a] -> b -> b)
  -> FieldDescr blistField "data-files"
           showFilePath :: FilePath -> DocshowFilePath           parseFilePathQ :: ReadP r FilePathparseFilePathQ
           dataFiles :: PackageDescription -> [FilePath]dataFiles              (\val pkg -> pkg :: PackageDescriptionpkg{dataFiles=val :: [FilePath]val})
 , simpleField ::
  String
  -> (a -> Doc)
  -> ReadP a a
  -> (b -> a)
  -> (a -> b -> b)
  -> FieldDescr bsimpleField "data-dir"
           showFilePath :: FilePath -> DocshowFilePath           parseFilePathQ :: ReadP r FilePathparseFilePathQ
           dataDir :: PackageDescription -> FilePathdataDir                (\val pkg -> pkg :: PackageDescriptionpkg{dataDir=val :: [FilePath]val})
 , listField ::
  String
  -> (a -> Doc)
  -> ReadP [a] a
  -> (b -> [a])
  -> ([a] -> b -> b)
  -> FieldDescr blistField "extra-source-files"
           showFilePath :: FilePath -> DocshowFilePath    parseFilePathQ :: ReadP r FilePathparseFilePathQ
           extraSrcFiles :: PackageDescription -> [FilePath]extraSrcFiles          (\val pkg -> pkg :: PackageDescriptionpkg{extraSrcFiles=val :: [FilePath]val})
 , listField ::
  String
  -> (a -> Doc)
  -> ReadP [a] a
  -> (b -> [a])
  -> ([a] -> b -> b)
  -> FieldDescr blistField "extra-tmp-files"
           showFilePath :: FilePath -> DocshowFilePath       parseFilePathQ :: ReadP r FilePathparseFilePathQ
           extraTmpFiles :: PackageDescription -> [FilePath]extraTmpFiles          (\val pkg -> pkg :: PackageDescriptionpkg{extraTmpFiles=val :: [FilePath]val})
 ]

-- | Store any fields beginning with "x-" in the customFields field of
--   a PackageDescription.  All other fields will generate a warning.
storeXFieldsPD :: UnrecFieldParser PackageDescription
storeXFieldsPD (f@('x':'-':_),val) pkg = Just :: a -> Maybe aJust pkg :: PackageDescriptionpkg{ customFieldsPD =
                                                        (customFieldsPD :: PackageDescription -> [(String, String)]customFieldsPD pkg :: PackageDescriptionpkg) (++) :: [a] -> [a] -> [a]++ [(f :: s -> m (a, s)f,val :: [FilePath]val)]}
storeXFieldsPD _ _ = Nothing :: Maybe aNothing

-- ---------------------------------------------------------------------------
-- The Library type

libFieldDescrs :: [FieldDescr Library]
libFieldDescrs =
  [ listField ::
  String
  -> (a -> Doc)
  -> ReadP [a] a
  -> (b -> [a])
  -> ([a] -> b -> b)
  -> FieldDescr blistField "exposed-modules" disp :: Text a => a -> Docdisp parseModuleNameQ :: ReadP r ModuleNameparseModuleNameQ
      exposedModules :: Library -> [ModuleName]exposedModules (\mods lib -> lib :: Librarylib{exposedModules=mods :: [ModuleName]mods})

  , boolField ::
  String -> (b -> Bool) -> (Bool -> b -> b) -> FieldDescr bboolField "exposed"
      libExposed :: Library -> BoollibExposed     (\val lib -> lib :: Librarylib{libExposed=val :: [FilePath]val})
  ] (++) :: [a] -> [a] -> [a]++ map :: (a -> b) -> [a] -> [b]map biToLib :: FieldDescr BuildInfo -> FieldDescr LibrarybiToLib binfoFieldDescrs :: [FieldDescr BuildInfo]binfoFieldDescrs
  where biToLib = liftField ::
  (b -> a) -> (a -> b -> b) -> FieldDescr a -> FieldDescr bliftField libBuildInfo :: Library -> BuildInfolibBuildInfo (\bi lib -> lib :: Librarylib{libBuildInfo=bi :: BuildInfobi})

storeXFieldsLib :: UnrecFieldParser Library
storeXFieldsLib (f@('x':'-':_), val) l@(Library { libBuildInfo = bi }) =
    Just :: a -> Maybe aJust ($) :: (a -> b) -> a -> b$ l :: LineNol {libBuildInfo = bi :: BuildInfobi{ customFieldsBI = (customFieldsBI :: BuildInfo -> [(String, String)]customFieldsBI bi :: BuildInfobi) (++) :: [a] -> [a] -> [a]++ [(f :: s -> m (a, s)f,val :: [FilePath]val)]}}
storeXFieldsLib _ _ = Nothing :: Maybe aNothing

-- ---------------------------------------------------------------------------
-- The Executable type


executableFieldDescrs :: [FieldDescr Executable]
executableFieldDescrs =
  [ -- note ordering: configuration must come first, for
    -- showPackageDescription.
    simpleField ::
  String
  -> (a -> Doc)
  -> ReadP a a
  -> (b -> a)
  -> (a -> b -> b)
  -> FieldDescr bsimpleField "executable"
                           showToken :: String -> DocshowToken          parseTokenQ :: ReadP r StringparseTokenQ
                           exeName :: Executable -> StringexeName            (\xs    exe -> exe :: Executableexe{exeName=xs :: [Dependency]xs})
  , simpleField ::
  String
  -> (a -> Doc)
  -> ReadP a a
  -> (b -> a)
  -> (a -> b -> b)
  -> FieldDescr bsimpleField "main-is"
                           showFilePath :: FilePath -> DocshowFilePath       parseFilePathQ :: ReadP r FilePathparseFilePathQ
                           modulePath :: Executable -> FilePathmodulePath         (\xs    exe -> exe :: Executableexe{modulePath=xs :: [Dependency]xs})
  ]
  (++) :: [a] -> [a] -> [a]++ map :: (a -> b) -> [a] -> [b]map biToExe :: FieldDescr BuildInfo -> FieldDescr ExecutablebiToExe binfoFieldDescrs :: [FieldDescr BuildInfo]binfoFieldDescrs
  where biToExe = liftField ::
  (b -> a) -> (a -> b -> b) -> FieldDescr a -> FieldDescr bliftField buildInfo :: Executable -> BuildInfobuildInfo (\bi exe -> exe :: Executableexe{buildInfo=bi :: BuildInfobi})

storeXFieldsExe :: UnrecFieldParser Executable
storeXFieldsExe (f@('x':'-':_), val) e@(Executable { buildInfo = bi }) =
    Just :: a -> Maybe aJust ($) :: (a -> b) -> a -> b$ e :: Stringe {buildInfo = bi :: BuildInfobi{ customFieldsBI = (f :: s -> m (a, s)f,val :: [FilePath]val)(:) :: a -> [a] -> [a]:(customFieldsBI :: BuildInfo -> [(String, String)]customFieldsBI bi :: BuildInfobi)}}
storeXFieldsExe _ _ = Nothing :: Maybe aNothing

-- ---------------------------------------------------------------------------
-- The TestSuite type

-- | An intermediate type just used for parsing the test-suite stanza.
-- After validation it is converted into the proper 'TestSuite' type.
data testStanzaTestModule :: Maybe ModuleNameTestSuiteStanza = TestSuiteStanza {
       testStanzaTestType   :: Maybe TestType,
       testStanzaMainIs     :: Maybe FilePath,
       testStanzaTestModule :: Maybe ModuleName,
       testStanzaBuildInfo  :: BuildInfo
     }

emptyTestStanza :: TestSuiteStanza
emptyTestStanza = TestSuiteStanza ::
  Maybe TestType
  -> Maybe FilePath
  -> Maybe ModuleName
  -> BuildInfo
  -> TestSuiteStanzaTestSuiteStanza Nothing :: Maybe aNothing Nothing :: Maybe aNothing Nothing :: Maybe aNothing mempty :: Monoid a => amempty

testSuiteFieldDescrs :: [FieldDescr TestSuiteStanza]
testSuiteFieldDescrs =
    [ simpleField ::
  String
  -> (a -> Doc)
  -> ReadP a a
  -> (b -> a)
  -> (a -> b -> b)
  -> FieldDescr bsimpleField "type"
        (maybe :: b -> (a -> b) -> Maybe a -> bmaybe empty :: Docempty disp :: Text a => a -> Docdisp)    (fmap :: Functor f => forall a b. (a -> b) -> f a -> f bfmap Just :: a -> Maybe aJust parse :: Text a => forall r. ReadP r aparse)
        testStanzaTestType :: TestSuiteStanza -> Maybe TestTypetestStanzaTestType    (\x suite -> suite :: TestSuiteStanzasuite { testStanzaTestType = x :: TestSuiteStanzax })
    , simpleField ::
  String
  -> (a -> Doc)
  -> ReadP a a
  -> (b -> a)
  -> (a -> b -> b)
  -> FieldDescr bsimpleField "main-is"
        (maybe :: b -> (a -> b) -> Maybe a -> bmaybe empty :: Docempty showFilePath :: FilePath -> DocshowFilePath)  (fmap :: Functor f => forall a b. (a -> b) -> f a -> f bfmap Just :: a -> Maybe aJust parseFilePathQ :: ReadP r FilePathparseFilePathQ)
        testStanzaMainIs :: TestSuiteStanza -> Maybe FilePathtestStanzaMainIs      (\x suite -> suite :: TestSuiteStanzasuite { testStanzaMainIs = x :: TestSuiteStanzax })
    , simpleField ::
  String
  -> (a -> Doc)
  -> ReadP a a
  -> (b -> a)
  -> (a -> b -> b)
  -> FieldDescr bsimpleField "test-module"
        (maybe :: b -> (a -> b) -> Maybe a -> bmaybe empty :: Docempty disp :: Text a => a -> Docdisp)    (fmap :: Functor f => forall a b. (a -> b) -> f a -> f bfmap Just :: a -> Maybe aJust parseModuleNameQ :: ReadP r ModuleNameparseModuleNameQ)
        testStanzaTestModule :: TestSuiteStanza -> Maybe ModuleNametestStanzaTestModule  (\x suite -> suite :: TestSuiteStanzasuite { testStanzaTestModule = x :: TestSuiteStanzax })
    ]
    (++) :: [a] -> [a] -> [a]++ map :: (a -> b) -> [a] -> [b]map biToTest :: FieldDescr BuildInfo -> FieldDescr TestSuiteStanzabiToTest binfoFieldDescrs :: [FieldDescr BuildInfo]binfoFieldDescrs
  where
    biToTest = liftField ::
  (b -> a) -> (a -> b -> b) -> FieldDescr a -> FieldDescr bliftField testStanzaBuildInfo :: TestSuiteStanza -> BuildInfotestStanzaBuildInfo
                         (\bi suite -> suite :: TestSuiteStanzasuite { testStanzaBuildInfo = bi :: BuildInfobi })

storeXFieldsTest :: UnrecFieldParser TestSuiteStanza
storeXFieldsTest (f@('x':'-':_), val) t@(TestSuiteStanza { testStanzaBuildInfo = bi }) =
    Just :: a -> Maybe aJust ($) :: (a -> b) -> a -> b$ t :: CondTree v c TestSuitet {testStanzaBuildInfo = bi :: BuildInfobi{ customFieldsBI = (f :: s -> m (a, s)f,val :: [FilePath]val)(:) :: a -> [a] -> [a]:(customFieldsBI :: BuildInfo -> [(String, String)]customFieldsBI bi :: BuildInfobi)}}
storeXFieldsTest _ _ = Nothing :: Maybe aNothing

validateTestSuite :: LineNo -> TestSuiteStanza -> ParseResult TestSuite
validateTestSuite line stanza =
    case testStanzaTestType :: TestSuiteStanza -> Maybe TestTypetestStanzaTestType stanza :: TestSuiteStanzastanza of
      Nothing -> return :: Monad m => forall a. a -> m areturn ($) :: (a -> b) -> a -> b$
        emptyTestSuite :: TestSuiteemptyTestSuite { testBuildInfo = testStanzaBuildInfo :: TestSuiteStanza -> BuildInfotestStanzaBuildInfo stanza :: TestSuiteStanzastanza }

      Just tt@(TestTypeUnknown _ _) ->
        return :: Monad m => forall a. a -> m areturn emptyTestSuite :: TestSuiteemptyTestSuite {
          testInterface = TestSuiteUnsupported :: TestType -> TestSuiteInterfaceTestSuiteUnsupported tt :: att,
          testBuildInfo = testStanzaBuildInfo :: TestSuiteStanza -> BuildInfotestStanzaBuildInfo stanza :: TestSuiteStanzastanza
        }

      Just tt | tt :: att notElem :: Eq a => a -> [a] -> Bool`notElem` knownTestTypes :: [TestType]knownTestTypes ->
        return :: Monad m => forall a. a -> m areturn emptyTestSuite :: TestSuiteemptyTestSuite {
          testInterface = TestSuiteUnsupported :: TestType -> TestSuiteInterfaceTestSuiteUnsupported tt :: att,
          testBuildInfo = testStanzaBuildInfo :: TestSuiteStanza -> BuildInfotestStanzaBuildInfo stanza :: TestSuiteStanzastanza
        }

      Just tt@(TestTypeExe ver) ->
        case testStanzaMainIs :: TestSuiteStanza -> Maybe FilePathtestStanzaMainIs stanza :: TestSuiteStanzastanza of
          Nothing   -> syntaxError :: LineNo -> String -> ParseResult asyntaxError line :: LineNoline (missingField :: [Char] -> a -> [Char]missingField "main-is" tt :: att)
          Just file -> do
            when :: Monad m => Bool -> m () -> m ()when (isJust :: Maybe a -> BoolisJust (testStanzaTestModule :: TestSuiteStanza -> Maybe ModuleNametestStanzaTestModule stanza :: TestSuiteStanzastanza)) ($) :: (a -> b) -> a -> b$
              warning :: String -> ParseResult ()warning (extraField :: [Char] -> a -> [Char]extraField "test-module" tt :: att)
            return :: Monad m => forall a. a -> m areturn emptyTestSuite :: TestSuiteemptyTestSuite {
              testInterface = TestSuiteExeV10 :: Version -> FilePath -> TestSuiteInterfaceTestSuiteExeV10 ver :: Versionver file :: Stringfile,
              testBuildInfo = testStanzaBuildInfo :: TestSuiteStanza -> BuildInfotestStanzaBuildInfo stanza :: TestSuiteStanzastanza
            }

      Just tt@(TestTypeLib ver) ->
        case testStanzaTestModule :: TestSuiteStanza -> Maybe ModuleNametestStanzaTestModule stanza :: TestSuiteStanzastanza of
          Nothing      -> syntaxError :: LineNo -> String -> ParseResult asyntaxError line :: LineNoline (missingField :: [Char] -> a -> [Char]missingField "test-module" tt :: att)
          Just module_ -> do
            when :: Monad m => Bool -> m () -> m ()when (isJust :: Maybe a -> BoolisJust (testStanzaMainIs :: TestSuiteStanza -> Maybe FilePathtestStanzaMainIs stanza :: TestSuiteStanzastanza)) ($) :: (a -> b) -> a -> b$
              warning :: String -> ParseResult ()warning (extraField :: [Char] -> a -> [Char]extraField "main-is" tt :: att)
            return :: Monad m => forall a. a -> m areturn emptyTestSuite :: TestSuiteemptyTestSuite {
              testInterface = TestSuiteLibV09 :: Version -> ModuleName -> TestSuiteInterfaceTestSuiteLibV09 ver :: Versionver module_ :: ModuleNamemodule_,
              testBuildInfo = testStanzaBuildInfo :: TestSuiteStanza -> BuildInfotestStanzaBuildInfo stanza :: TestSuiteStanzastanza
            }

  where
    missingField name tt = "The '" (++) :: [a] -> [a] -> [a]++ name :: PackageNamename (++) :: [a] -> [a] -> [a]++ "' field is required for the "
                        (++) :: [a] -> [a] -> [a]++ display :: Text a => a -> Stringdisplay tt :: att (++) :: [a] -> [a] -> [a]++ " test suite type."

    extraField   name tt = "The '" (++) :: [a] -> [a] -> [a]++ name :: PackageNamename (++) :: [a] -> [a] -> [a]++ "' field is not used for the '"
                        (++) :: [a] -> [a] -> [a]++ display :: Text a => a -> Stringdisplay tt :: att (++) :: [a] -> [a] -> [a]++ "' test suite type."


-- ---------------------------------------------------------------------------
-- The BuildInfo type


binfoFieldDescrs :: [FieldDescr BuildInfo]
binfoFieldDescrs =
 [ boolField ::
  String -> (b -> Bool) -> (Bool -> b -> b) -> FieldDescr bboolField "buildable"
           buildable :: BuildInfo -> Boolbuildable          (\val binfo -> binfo :: BuildInfobinfo{buildable=val :: [FilePath]val})
 , commaListField ::
  String
  -> (a -> Doc)
  -> ReadP [a] a
  -> (b -> [a])
  -> ([a] -> b -> b)
  -> FieldDescr bcommaListField  "build-tools"
           disp :: Text a => a -> Docdisp               parseBuildTool :: ReadP r DependencyparseBuildTool
           buildTools :: BuildInfo -> [Dependency]buildTools         (\xs  binfo -> binfo :: BuildInfobinfo{buildTools=xs :: [Dependency]xs})
 , spaceListField ::
  String
  -> (a -> Doc)
  -> ReadP [a] a
  -> (b -> [a])
  -> ([a] -> b -> b)
  -> FieldDescr bspaceListField "cpp-options"
           showToken :: String -> DocshowToken          parseTokenQ' :: ReadP r StringparseTokenQ'
           cppOptions :: BuildInfo -> [String]cppOptions          (\val binfo -> binfo :: BuildInfobinfo{cppOptions=val :: [FilePath]val})
 , spaceListField ::
  String
  -> (a -> Doc)
  -> ReadP [a] a
  -> (b -> [a])
  -> ([a] -> b -> b)
  -> FieldDescr bspaceListField "cc-options"
           showToken :: String -> DocshowToken          parseTokenQ' :: ReadP r StringparseTokenQ'
           ccOptions :: BuildInfo -> [String]ccOptions          (\val binfo -> binfo :: BuildInfobinfo{ccOptions=val :: [FilePath]val})
 , spaceListField ::
  String
  -> (a -> Doc)
  -> ReadP [a] a
  -> (b -> [a])
  -> ([a] -> b -> b)
  -> FieldDescr bspaceListField "ld-options"
           showToken :: String -> DocshowToken          parseTokenQ' :: ReadP r StringparseTokenQ'
           ldOptions :: BuildInfo -> [String]ldOptions          (\val binfo -> binfo :: BuildInfobinfo{ldOptions=val :: [FilePath]val})
 , commaListField ::
  String
  -> (a -> Doc)
  -> ReadP [a] a
  -> (b -> [a])
  -> ([a] -> b -> b)
  -> FieldDescr bcommaListField  "pkgconfig-depends"
           disp :: Text a => a -> Docdisp               parsePkgconfigDependency :: ReadP r DependencyparsePkgconfigDependency
           pkgconfigDepends :: BuildInfo -> [Dependency]pkgconfigDepends   (\xs  binfo -> binfo :: BuildInfobinfo{pkgconfigDepends=xs :: [Dependency]xs})
 , listField ::
  String
  -> (a -> Doc)
  -> ReadP [a] a
  -> (b -> [a])
  -> ([a] -> b -> b)
  -> FieldDescr blistField "frameworks"
           showToken :: String -> DocshowToken          parseTokenQ :: ReadP r StringparseTokenQ
           frameworks :: BuildInfo -> [String]frameworks         (\val binfo -> binfo :: BuildInfobinfo{frameworks=val :: [FilePath]val})
 , listField ::
  String
  -> (a -> Doc)
  -> ReadP [a] a
  -> (b -> [a])
  -> ([a] -> b -> b)
  -> FieldDescr blistField   "c-sources"
           showFilePath :: FilePath -> DocshowFilePath       parseFilePathQ :: ReadP r FilePathparseFilePathQ
           cSources :: BuildInfo -> [FilePath]cSources           (\paths binfo -> binfo :: BuildInfobinfo{cSources=paths :: [FilePath]paths})

 , simpleField ::
  String
  -> (a -> Doc)
  -> ReadP a a
  -> (b -> a)
  -> (a -> b -> b)
  -> FieldDescr bsimpleField "default-language"
           (maybe :: b -> (a -> b) -> Maybe a -> bmaybe empty :: Docempty disp :: Text a => a -> Docdisp) (option :: a -> ReadP r a -> ReadP r aoption Nothing :: Maybe aNothing (fmap :: Functor f => forall a b. (a -> b) -> f a -> f bfmap Just :: a -> Maybe aJust parseLanguageQ :: ReadP r LanguageparseLanguageQ))
           defaultLanguage :: BuildInfo -> Maybe LanguagedefaultLanguage    (\lang  binfo -> binfo :: BuildInfobinfo{defaultLanguage=lang :: Maybe Languagelang})
 , listField ::
  String
  -> (a -> Doc)
  -> ReadP [a] a
  -> (b -> [a])
  -> ([a] -> b -> b)
  -> FieldDescr blistField   "other-languages"
           disp :: Text a => a -> Docdisp               parseLanguageQ :: ReadP r LanguageparseLanguageQ
           otherLanguages :: BuildInfo -> [Language]otherLanguages     (\langs binfo -> binfo :: BuildInfobinfo{otherLanguages=langs :: [Language]langs})
 , listField ::
  String
  -> (a -> Doc)
  -> ReadP [a] a
  -> (b -> [a])
  -> ([a] -> b -> b)
  -> FieldDescr blistField   "default-extensions"
           disp :: Text a => a -> Docdisp               parseExtensionQ :: ReadP r ExtensionparseExtensionQ
           defaultExtensions :: BuildInfo -> [Extension]defaultExtensions  (\exts  binfo -> binfo :: BuildInfobinfo{defaultExtensions=exts :: [Extension]exts})
 , listField ::
  String
  -> (a -> Doc)
  -> ReadP [a] a
  -> (b -> [a])
  -> ([a] -> b -> b)
  -> FieldDescr blistField   "other-extensions"
           disp :: Text a => a -> Docdisp               parseExtensionQ :: ReadP r ExtensionparseExtensionQ
           otherExtensions :: BuildInfo -> [Extension]otherExtensions    (\exts  binfo -> binfo :: BuildInfobinfo{otherExtensions=exts :: [Extension]exts})
 , listField ::
  String
  -> (a -> Doc)
  -> ReadP [a] a
  -> (b -> [a])
  -> ([a] -> b -> b)
  -> FieldDescr blistField   "extensions"
           disp :: Text a => a -> Docdisp               parseExtensionQ :: ReadP r ExtensionparseExtensionQ
           oldExtensions :: BuildInfo -> [Extension]oldExtensions      (\exts  binfo -> binfo :: BuildInfobinfo{oldExtensions=exts :: [Extension]exts})

 , listField ::
  String
  -> (a -> Doc)
  -> ReadP [a] a
  -> (b -> [a])
  -> ([a] -> b -> b)
  -> FieldDescr blistField   "extra-libraries"
           showToken :: String -> DocshowToken          parseTokenQ :: ReadP r StringparseTokenQ
           extraLibs :: BuildInfo -> [String]extraLibs          (\xs    binfo -> binfo :: BuildInfobinfo{extraLibs=xs :: [Dependency]xs})
 , listField ::
  String
  -> (a -> Doc)
  -> ReadP [a] a
  -> (b -> [a])
  -> ([a] -> b -> b)
  -> FieldDescr blistField   "extra-lib-dirs"
           showFilePath :: FilePath -> DocshowFilePath       parseFilePathQ :: ReadP r FilePathparseFilePathQ
           extraLibDirs :: BuildInfo -> [String]extraLibDirs       (\xs    binfo -> binfo :: BuildInfobinfo{extraLibDirs=xs :: [Dependency]xs})
 , listField ::
  String
  -> (a -> Doc)
  -> ReadP [a] a
  -> (b -> [a])
  -> ([a] -> b -> b)
  -> FieldDescr blistField   "includes"
           showFilePath :: FilePath -> DocshowFilePath       parseFilePathQ :: ReadP r FilePathparseFilePathQ
           includes :: BuildInfo -> [FilePath]includes           (\paths binfo -> binfo :: BuildInfobinfo{includes=paths :: [FilePath]paths})
 , listField ::
  String
  -> (a -> Doc)
  -> ReadP [a] a
  -> (b -> [a])
  -> ([a] -> b -> b)
  -> FieldDescr blistField   "install-includes"
           showFilePath :: FilePath -> DocshowFilePath       parseFilePathQ :: ReadP r FilePathparseFilePathQ
           installIncludes :: BuildInfo -> [FilePath]installIncludes    (\paths binfo -> binfo :: BuildInfobinfo{installIncludes=paths :: [FilePath]paths})
 , listField ::
  String
  -> (a -> Doc)
  -> ReadP [a] a
  -> (b -> [a])
  -> ([a] -> b -> b)
  -> FieldDescr blistField   "include-dirs"
           showFilePath :: FilePath -> DocshowFilePath       parseFilePathQ :: ReadP r FilePathparseFilePathQ
           includeDirs :: BuildInfo -> [FilePath]includeDirs        (\paths binfo -> binfo :: BuildInfobinfo{includeDirs=paths :: [FilePath]paths})
 , listField ::
  String
  -> (a -> Doc)
  -> ReadP [a] a
  -> (b -> [a])
  -> ([a] -> b -> b)
  -> FieldDescr blistField   "hs-source-dirs"
           showFilePath :: FilePath -> DocshowFilePath       parseFilePathQ :: ReadP r FilePathparseFilePathQ
           hsSourceDirs :: BuildInfo -> [FilePath]hsSourceDirs       (\paths binfo -> binfo :: BuildInfobinfo{hsSourceDirs=paths :: [FilePath]paths})
 , listField ::
  String
  -> (a -> Doc)
  -> ReadP [a] a
  -> (b -> [a])
  -> ([a] -> b -> b)
  -> FieldDescr blistField   "other-modules"
           disp :: Text a => a -> Docdisp               parseModuleNameQ :: ReadP r ModuleNameparseModuleNameQ
           otherModules :: BuildInfo -> [ModuleName]otherModules       (\val binfo -> binfo :: BuildInfobinfo{otherModules=val :: [FilePath]val})
 , listField ::
  String
  -> (a -> Doc)
  -> ReadP [a] a
  -> (b -> [a])
  -> ([a] -> b -> b)
  -> FieldDescr blistField   "ghc-prof-options"
           text :: String -> Doctext               parseTokenQ :: ReadP r StringparseTokenQ
           ghcProfOptions :: BuildInfo -> [String]ghcProfOptions        (\val binfo -> binfo :: BuildInfobinfo{ghcProfOptions=val :: [FilePath]val})
 , listField ::
  String
  -> (a -> Doc)
  -> ReadP [a] a
  -> (b -> [a])
  -> ([a] -> b -> b)
  -> FieldDescr blistField   "ghc-shared-options"
           text :: String -> Doctext               parseTokenQ :: ReadP r StringparseTokenQ
           ghcSharedOptions :: BuildInfo -> [String]ghcSharedOptions      (\val binfo -> binfo :: BuildInfobinfo{ghcSharedOptions=val :: [FilePath]val})
 , optsField ::
  String
  -> CompilerFlavor
  -> (b -> [(CompilerFlavor, [String])])
  -> ([(CompilerFlavor, [String])] -> b -> b)
  -> FieldDescr boptsField   "ghc-options"  GHC :: CompilerFlavorGHC
           options :: BuildInfo -> [(CompilerFlavor, [String])]options            (\path  binfo -> binfo :: BuildInfobinfo{options=path :: [(CompilerFlavor, [String])]path})
 , optsField ::
  String
  -> CompilerFlavor
  -> (b -> [(CompilerFlavor, [String])])
  -> ([(CompilerFlavor, [String])] -> b -> b)
  -> FieldDescr boptsField   "hugs-options" Hugs :: CompilerFlavorHugs
           options :: BuildInfo -> [(CompilerFlavor, [String])]options            (\path  binfo -> binfo :: BuildInfobinfo{options=path :: [(CompilerFlavor, [String])]path})
 , optsField ::
  String
  -> CompilerFlavor
  -> (b -> [(CompilerFlavor, [String])])
  -> ([(CompilerFlavor, [String])] -> b -> b)
  -> FieldDescr boptsField   "nhc98-options"  NHC :: CompilerFlavorNHC
           options :: BuildInfo -> [(CompilerFlavor, [String])]options            (\path  binfo -> binfo :: BuildInfobinfo{options=path :: [(CompilerFlavor, [String])]path})
 , optsField ::
  String
  -> CompilerFlavor
  -> (b -> [(CompilerFlavor, [String])])
  -> ([(CompilerFlavor, [String])] -> b -> b)
  -> FieldDescr boptsField   "jhc-options"  JHC :: CompilerFlavorJHC
           options :: BuildInfo -> [(CompilerFlavor, [String])]options            (\path  binfo -> binfo :: BuildInfobinfo{options=path :: [(CompilerFlavor, [String])]path})
 ]

storeXFieldsBI :: UnrecFieldParser BuildInfo
storeXFieldsBI (f@('x':'-':_),val) bi = Just :: a -> Maybe aJust bi :: BuildInfobi{ customFieldsBI = (f :: s -> m (a, s)f,val :: [FilePath]val)(:) :: a -> [a] -> [a]:(customFieldsBI :: BuildInfo -> [(String, String)]customFieldsBI bi :: BuildInfobi) }
storeXFieldsBI _ _ = Nothing :: Maybe aNothing

------------------------------------------------------------------------------

flagFieldDescrs :: [FieldDescr Flag]
flagFieldDescrs =
    [ simpleField ::
  String
  -> (a -> Doc)
  -> ReadP a a
  -> (b -> a)
  -> (a -> b -> b)
  -> FieldDescr bsimpleField "description"
        showFreeText :: String -> DocshowFreeText     parseFreeText :: ReadP s StringparseFreeText
        flagDescription :: Flag -> StringflagDescription  (\val fl -> fl :: Flagfl{ flagDescription = val :: [FilePath]val })
    , boolField ::
  String -> (b -> Bool) -> (Bool -> b -> b) -> FieldDescr bboolField "default"
        flagDefault :: Flag -> BoolflagDefault      (\val fl -> fl :: Flagfl{ flagDefault = val :: [FilePath]val })
    , boolField ::
  String -> (b -> Bool) -> (Bool -> b -> b) -> FieldDescr bboolField "manual"
        flagManual :: Flag -> BoolflagManual       (\val fl -> fl :: Flagfl{ flagManual = val :: [FilePath]val })
    ]

------------------------------------------------------------------------------

sourceRepoFieldDescrs :: [FieldDescr SourceRepo]
sourceRepoFieldDescrs =
    [ simpleField ::
  String
  -> (a -> Doc)
  -> ReadP a a
  -> (b -> a)
  -> (a -> b -> b)
  -> FieldDescr bsimpleField "type"
        (maybe :: b -> (a -> b) -> Maybe a -> bmaybe empty :: Docempty disp :: Text a => a -> Docdisp)         (fmap :: Functor f => forall a b. (a -> b) -> f a -> f bfmap Just :: a -> Maybe aJust parse :: Text a => forall r. ReadP r aparse)
        repoType :: SourceRepo -> Maybe RepoTyperepoType                   (\val repo -> repo :: SourceReporepo { repoType = val :: [FilePath]val })
    , simpleField ::
  String
  -> (a -> Doc)
  -> ReadP a a
  -> (b -> a)
  -> (a -> b -> b)
  -> FieldDescr bsimpleField "location"
        (maybe :: b -> (a -> b) -> Maybe a -> bmaybe empty :: Docempty showFreeText :: String -> DocshowFreeText) (fmap :: Functor f => forall a b. (a -> b) -> f a -> f bfmap Just :: a -> Maybe aJust parseFreeText :: ReadP s StringparseFreeText)
        repoLocation :: SourceRepo -> Maybe StringrepoLocation               (\val repo -> repo :: SourceReporepo { repoLocation = val :: [FilePath]val })
    , simpleField ::
  String
  -> (a -> Doc)
  -> ReadP a a
  -> (b -> a)
  -> (a -> b -> b)
  -> FieldDescr bsimpleField "module"
        (maybe :: b -> (a -> b) -> Maybe a -> bmaybe empty :: Docempty showToken :: String -> DocshowToken)    (fmap :: Functor f => forall a b. (a -> b) -> f a -> f bfmap Just :: a -> Maybe aJust parseTokenQ :: ReadP r StringparseTokenQ)
        repoModule :: SourceRepo -> Maybe StringrepoModule                 (\val repo -> repo :: SourceReporepo { repoModule = val :: [FilePath]val })
    , simpleField ::
  String
  -> (a -> Doc)
  -> ReadP a a
  -> (b -> a)
  -> (a -> b -> b)
  -> FieldDescr bsimpleField "branch"
        (maybe :: b -> (a -> b) -> Maybe a -> bmaybe empty :: Docempty showToken :: String -> DocshowToken)    (fmap :: Functor f => forall a b. (a -> b) -> f a -> f bfmap Just :: a -> Maybe aJust parseTokenQ :: ReadP r StringparseTokenQ)
        repoBranch :: SourceRepo -> Maybe StringrepoBranch                 (\val repo -> repo :: SourceReporepo { repoBranch = val :: [FilePath]val })
    , simpleField ::
  String
  -> (a -> Doc)
  -> ReadP a a
  -> (b -> a)
  -> (a -> b -> b)
  -> FieldDescr bsimpleField "tag"
        (maybe :: b -> (a -> b) -> Maybe a -> bmaybe empty :: Docempty showToken :: String -> DocshowToken)    (fmap :: Functor f => forall a b. (a -> b) -> f a -> f bfmap Just :: a -> Maybe aJust parseTokenQ :: ReadP r StringparseTokenQ)
        repoTag :: SourceRepo -> Maybe StringrepoTag                    (\val repo -> repo :: SourceReporepo { repoTag = val :: [FilePath]val })
    , simpleField ::
  String
  -> (a -> Doc)
  -> ReadP a a
  -> (b -> a)
  -> (a -> b -> b)
  -> FieldDescr bsimpleField "subdir"
        (maybe :: b -> (a -> b) -> Maybe a -> bmaybe empty :: Docempty showFilePath :: FilePath -> DocshowFilePath) (fmap :: Functor f => forall a b. (a -> b) -> f a -> f bfmap Just :: a -> Maybe aJust parseFilePathQ :: ReadP r FilePathparseFilePathQ)
        repoSubdir :: SourceRepo -> Maybe FilePathrepoSubdir                 (\val repo -> repo :: SourceReporepo { repoSubdir = val :: [FilePath]val })
    ]

-- ---------------------------------------------------------------
-- Parsing

-- | Given a parser and a filename, return the parse of the file,
-- after checking if the file exists.
readAndParseFile :: (FilePath -> (String -> IO a) -> IO a)
                 -> (String -> ParseResult a)
                 -> Verbosity
                 -> FilePath -> IO a
readAndParseFile withFileContents' parser verbosity fpath = do
  exists <- doesFileExist :: FilePath -> IO BooldoesFileExist fpath :: FilePathfpath
  when :: Monad m => Bool -> m () -> m ()when (not :: Bool -> Boolnot exists :: Boolexists) (die :: String -> IO adie ($) :: (a -> b) -> a -> b$ "Error Parsing: file \"" (++) :: [a] -> [a] -> [a]++ fpath :: FilePathfpath (++) :: [a] -> [a] -> [a]++ "\" doesn't exist. Cannot continue.")
  withFileContents' :: FilePath -> (String -> IO a) -> IO awithFileContents' fpath :: FilePathfpath ($) :: (a -> b) -> a -> b$ \str -> case parser :: [Field] -> PM aparser str :: Stringstr of
    ParseFailed e -> do
        let (line, message) = locatedErrorMsg :: PError -> (Maybe LineNo, String)locatedErrorMsg e :: Stringe
        dieWithLocation :: FilePath -> Maybe Int -> String -> IO adieWithLocation fpath :: FilePathfpath line :: LineNoline message :: [Char]message
    ParseOk warnings x -> do
        mapM_ :: Monad m => (a -> m b) -> [a] -> m ()mapM_ (warn :: Verbosity -> String -> IO ()warn verbosity :: Verbosityverbosity (.) :: (b -> c) -> (a -> b) -> a -> c. showPWarning :: FilePath -> PWarning -> StringshowPWarning fpath :: FilePathfpath) ($) :: (a -> b) -> a -> b$ reverse :: [a] -> [a]reverse warnings :: [PWarning]warnings
        return :: Monad m => forall a. a -> m areturn x :: TestSuiteStanzax

readHookedBuildInfo :: Verbosity -> FilePath -> IO HookedBuildInfo
readHookedBuildInfo =
    readAndParseFile ::
  (FilePath -> (String -> IO a) -> IO a)
  -> (String -> ParseResult a)
  -> Verbosity
  -> FilePath
  -> IO areadAndParseFile withFileContents :: FilePath -> (String -> IO a) -> IO awithFileContents parseHookedBuildInfo :: String -> ParseResult HookedBuildInfoparseHookedBuildInfo

-- |Parse the given package file.
readPackageDescription :: Verbosity -> FilePath -> IO GenericPackageDescription
readPackageDescription =
    readAndParseFile ::
  (FilePath -> (String -> IO a) -> IO a)
  -> (String -> ParseResult a)
  -> Verbosity
  -> FilePath
  -> IO areadAndParseFile withUTF8FileContents :: FilePath -> (String -> IO a) -> IO awithUTF8FileContents parsePackageDescription ::
  String -> ParseResult GenericPackageDescriptionparsePackageDescription

stanzas :: [Field] -> [[Field]]
stanzas [] = [] :: [a][]
stanzas (f:fields) = (f :: s -> m (a, s)f(:) :: a -> [a] -> [a]:this :: [Field]this) (:) :: a -> [a] -> [a]: stanzas :: [Field] -> [[Field]]stanzas rest :: [Field]rest
  where
    (this, rest) = break :: (a -> Bool) -> [a] -> ([a], [a])break isStanzaHeader :: Field -> BoolisStanzaHeader fields :: [Field]fields

isStanzaHeader :: Field -> Bool
isStanzaHeader (F _ f _) = f :: s -> m (a, s)f (==) :: Eq a => a -> a -> Bool== "executable"
isStanzaHeader _ = False :: BoolFalse

------------------------------------------------------------------------------


mapSimpleFields :: (Field -> ParseResult Field) -> [Field]
                -> ParseResult [Field]
mapSimpleFields f fs = mapM :: Monad m => (a -> m b) -> [a] -> m [b]mapM walk :: Field -> ParseResult Fieldwalk fs :: [Field]fs
  where
    walk fld@(F _ _ _) = f :: s -> m (a, s)f fld :: Fieldfld
    walk (IfBlock l c fs1 fs2) = do
      fs1' <- mapM :: Monad m => (a -> m b) -> [a] -> m [b]mapM walk :: Field -> ParseResult Fieldwalk fs1 :: [Field]fs1
      fs2' <- mapM :: Monad m => (a -> m b) -> [a] -> m [b]mapM walk :: Field -> ParseResult Fieldwalk fs2 :: [Field]fs2
      return :: Monad m => forall a. a -> m areturn (IfBlock :: LineNo -> String -> [Field] -> [Field] -> FieldIfBlock l :: LineNol c :: Stringc fs1' :: [Field]fs1' fs2' :: [Field]fs2')
    walk (Section ln n l fs1) = do
      fs1' <-  mapM :: Monad m => (a -> m b) -> [a] -> m [b]mapM walk :: Field -> ParseResult Fieldwalk fs1 :: [Field]fs1
      return :: Monad m => forall a. a -> m areturn (Section :: LineNo -> String -> String -> [Field] -> FieldSection ln :: LineNoln n :: Stringn l :: LineNol fs1' :: [Field]fs1')

-- prop_isMapM fs = mapSimpleFields return fs == return fs


-- names of fields that represents dependencies, thus consrca
constraintFieldNames :: [String]
constraintFieldNames = ["build-depends"]

-- Possible refactoring would be to have modifiers be explicit about what
-- they add and define an accessor that specifies what the dependencies
-- are.  This way we would completely reuse the parsing knowledge from the
-- field descriptor.
parseConstraint :: Field -> ParseResult [Dependency]
parseConstraint (F l n v)
    | n :: Stringn (==) :: Eq a => a -> a -> Bool== "build-depends" = runP :: LineNo -> String -> ReadP a a -> String -> ParseResult arunP l :: LineNol n :: Stringn (parseCommaList :: ReadP r a -> ReadP r [a]parseCommaList parse :: Text a => forall r. ReadP r aparse) v :: Stringv
parseConstraint f = bug :: String -> abug ($) :: (a -> b) -> a -> b$ "Constraint was expected (got: " (++) :: [a] -> [a] -> [a]++ show :: Show a => a -> Stringshow f :: s -> m (a, s)f (++) :: [a] -> [a] -> [a]++ ")"

{-
headerFieldNames :: [String]
headerFieldNames = filter (\n -> not (n `elem` constraintFieldNames))
                 . map fieldName $ pkgDescrFieldDescrs
-}

libFieldNames :: [String]
libFieldNames = map :: (a -> b) -> [a] -> [b]map fieldName :: FieldDescr a -> StringfieldName libFieldDescrs :: [FieldDescr Library]libFieldDescrs
                (++) :: [a] -> [a] -> [a]++ buildInfoNames :: [String]buildInfoNames (++) :: [a] -> [a] -> [a]++ constraintFieldNames :: [String]constraintFieldNames

-- exeFieldNames :: [String]
-- exeFieldNames = map fieldName executableFieldDescrs
--                 ++ buildInfoNames

buildInfoNames :: [String]
buildInfoNames = map :: (a -> b) -> [a] -> [b]map fieldName :: FieldDescr a -> StringfieldName binfoFieldDescrs :: [FieldDescr BuildInfo]binfoFieldDescrs
                (++) :: [a] -> [a] -> [a]++ map :: (a -> b) -> [a] -> [b]map fst :: (a, b) -> afst deprecatedFieldsBuildInfo :: [(String, String)]deprecatedFieldsBuildInfo

-- A minimal implementation of the StateT monad transformer to avoid depending
-- on the 'mtl' package.
newtype runStT :: s -> m (a, s)StT s m a = StT { runStT :: s -> m (a,s) }

instance D:Monad ::
  (forall a b. m a -> (a -> m b) -> m b)
  -> (forall a b. m a -> m b -> m b)
  -> (forall a. a -> m a)
  -> (forall a. String -> m a)
  -> T:Monad mMonad m => Monad (StT s m) where
    return a = StT :: (s -> m (a, s)) -> StT s m aStT (\s -> return :: Monad m => forall a. a -> m areturn (a :: aa,s :: ss))
    StT f >>= g = StT :: (s -> m (a, s)) -> StT s m aStT ($) :: (a -> b) -> a -> b$ \s -> do
                        (a,s') <- f :: s -> m (a, s)f s :: ss
                        runStT :: StT s m a -> s -> m (a, s)runStT (g :: a -> StT s m bg a :: aa) s' :: ss'

get :: Monad m => StT s m s
get = StT :: (s -> m (a, s)) -> StT s m aStT ($) :: (a -> b) -> a -> b$ \s -> return :: Monad m => forall a. a -> m areturn (s :: ss, s :: ss)

modify :: Monad m => (s -> s) -> StT s m ()
modify f = StT :: (s -> m (a, s)) -> StT s m aStT ($) :: (a -> b) -> a -> b$ \s -> return :: Monad m => forall a. a -> m areturn ((),f :: s -> m (a, s)f s :: ss)

lift :: Monad m => m a -> StT s m a
lift m = StT :: (s -> m (a, s)) -> StT s m aStT ($) :: (a -> b) -> a -> b$ \s -> m :: m am (>>=) :: Monad m => forall a b. m a -> (a -> m b) -> m b>>= \a -> return :: Monad m => forall a. a -> m areturn (a :: aa,s :: ss)

evalStT :: Monad m => StT s m a -> s -> m a
evalStT st s = runStT :: StT s m a -> s -> m (a, s)runStT st :: [Field]st s :: ss (>>=) :: Monad m => forall a b. m a -> (a -> m b) -> m b>>= return :: Monad m => forall a. a -> m areturn (.) :: (b -> c) -> (a -> b) -> a -> c. fst :: (a, b) -> afst

-- Our monad for parsing a list/tree of fields.
--
-- The state represents the remaining fields to be processed.
type PM a = StT [Field] ParseResult a



-- return look-ahead field or nothing if we're at the end of the file
peekField :: PM (Maybe Field)
peekField = get :: Monad m => StT s m sget (>>=) :: Monad m => forall a b. m a -> (a -> m b) -> m b>>= return :: Monad m => forall a. a -> m areturn (.) :: (b -> c) -> (a -> b) -> a -> c. listToMaybe :: [a] -> Maybe alistToMaybe

-- Unconditionally discard the first field in our state.  Will error when it
-- reaches end of file.  (Yes, that's evil.)
skipField :: PM ()
skipField = modify :: Monad m => (s -> s) -> StT s m ()modify tail :: [a] -> [a]tail

--FIXME: this should take a ByteString, not a String. We have to be able to
-- decode UTF8 and handle the BOM.

-- | Parses the given file into a 'GenericPackageDescription'.
--
-- In Cabal 1.2 the syntax for package descriptions was changed to a format
-- with sections and possibly indented property descriptions.
parsePackageDescription :: String -> ParseResult GenericPackageDescription
parsePackageDescription file = do

    -- This function is quite complex because it needs to be able to parse
    -- both pre-Cabal-1.2 and post-Cabal-1.2 files.  Additionally, it contains
    -- a lot of parser-related noise since we do not want to depend on Parsec.
    --
    -- If we detect an pre-1.2 file we implicitly convert it to post-1.2
    -- style.  See 'sectionizeFields' below for details about the conversion.

    fields0 <- readFields :: String -> ParseResult [Field]readFields file :: Stringfile catchParseError ::
  ParseResult a -> (PError -> ParseResult a) -> ParseResult a`catchParseError` \err ->
                 let tabs = findIndentTabs :: String -> [(Int, Int)]findIndentTabs file :: Stringfile in
                 case err :: PErrorerr of
                   -- In case of a TabsError report them all at once.
                   TabsError tabLineNo -> reportTabsError :: [(LineNo, b)] -> ParseResult areportTabsError
                   -- but only report the ones including and following
                   -- the one that caused the actual error
                                            [ t :: CondTree v c TestSuitet | t@(lineNo',_) <- tabs :: [(LineNo, b)]tabs
                                                , lineNo' :: IntlineNo' (>=) :: Ord a => a -> a -> Bool>= tabLineNo :: LineNotabLineNo ]
                   _ -> parseFail :: PError -> ParseResult aparseFail err :: PErrorerr

    let cabalVersionNeeded =
          head :: [a] -> ahead ($) :: (a -> b) -> a -> b$ [ minVersionBound :: VersionRange -> VersionminVersionBound versionRange :: VersionRangeversionRange
                 | Just versionRange <- [ simpleParse :: Text a => String -> Maybe asimpleParse v :: Stringv
                                        | F _ "cabal-version" v <- fields0 :: [Field]fields0 ] ]
              (++) :: [a] -> [a] -> [a]++ [Version :: [Int] -> [String] -> VersionVersion [0] [] :: [a][]]
        minVersionBound versionRange =
          case asVersionIntervals :: VersionRange -> [VersionInterval]asVersionIntervals versionRange :: VersionRangeversionRange of
            []                            -> Version :: [Int] -> [String] -> VersionVersion [0] [] :: [a][]
            ((LowerBound version _, _):_) -> version :: Versionversion

    handleFutureVersionParseFailure ::
  Version -> ParseResult a -> ParseResult ahandleFutureVersionParseFailure cabalVersionNeeded :: VersioncabalVersionNeeded ($) :: (a -> b) -> a -> b$ do

      let sf = sectionizeFields :: [Field] -> [Field]sectionizeFields fields0 :: [Field]fields0  -- ensure 1.2 format

        -- figure out and warn about deprecated stuff (warnings are collected
        -- inside our parsing monad)
      fields <- mapSimpleFields ::
  (Field -> ParseResult Field) -> [Field] -> ParseResult [Field]mapSimpleFields deprecField :: Field -> ParseResult FielddeprecField sf :: [Field]sf

        -- Our parsing monad takes the not-yet-parsed fields as its state.
        -- After each successful parse we remove the field from the state
        -- ('skipField') and move on to the next one.
        --
        -- Things are complicated a bit, because fields take a tree-like
        -- structure -- they can be sections or "if"/"else" conditionals.

      flip :: (a -> b -> c) -> b -> a -> cflip evalStT :: Monad m => StT s m a -> s -> m aevalStT fields :: [Field]fields ($) :: (a -> b) -> a -> b$ do

          -- The header consists of all simple fields up to the first section
          -- (flag, library, executable).
        header_fields <- getHeader :: [Field] -> PM [Field]getHeader [] :: [a][]

          -- Parses just the header fields and stores them in a
          -- 'PackageDescription'.  Note that our final result is a
          -- 'GenericPackageDescription'; for pragmatic reasons we just store
          -- the partially filled-out 'PackageDescription' inside the
          -- 'GenericPackageDescription'.
        pkg <- lift :: Monad m => m a -> StT s m alift ($) :: (a -> b) -> a -> b$ parseFields ::
  [FieldDescr a]
  -> UnrecFieldParser a
  -> a
  -> [Field]
  -> ParseResult aparseFields pkgDescrFieldDescrs :: [FieldDescr PackageDescription]pkgDescrFieldDescrs
                                  storeXFieldsPD :: UnrecFieldParser PackageDescriptionstoreXFieldsPD
                                  emptyPackageDescription :: PackageDescriptionemptyPackageDescription
                                  header_fields :: [Field]header_fields

          -- 'getBody' assumes that the remaining fields only consist of
          -- flags, lib and exe sections.
        (repos, flags, mlib, exes, tests) <- getBody ::
  PM
    ([SourceRepo],
     [Flag],
     Maybe (CondTree ConfVar [Dependency] Library),
     [(String, CondTree ConfVar [Dependency] Executable)],
     [(String, CondTree ConfVar [Dependency] TestSuite)])getBody
        warnIfRest :: PM ()warnIfRest  -- warn if getBody did not parse up to the last field.
          -- warn about using old/new syntax with wrong cabal-version:
        maybeWarnCabalVersion ::
  Bool -> PackageDescription -> StT s ParseResult ()maybeWarnCabalVersion (not :: Bool -> Boolnot ($) :: (a -> b) -> a -> b$ oldSyntax :: [Field] -> BoololdSyntax fields0 :: [Field]fields0) pkg :: PackageDescriptionpkg
        checkForUndefinedFlags ::
  [Flag]
  -> Maybe (CondTree ConfVar [Dependency] Library)
  -> [(String, CondTree ConfVar [Dependency] Executable)]
  -> [(String, CondTree ConfVar [Dependency] TestSuite)]
  -> PM ()checkForUndefinedFlags flags :: [Flag]flags mlib :: Maybe (CondTree ConfVar [Dependency] Library)mlib exes :: [Field]exes tests :: [(String, CondTree ConfVar [Dependency] TestSuite)]tests
        return :: Monad m => forall a. a -> m areturn ($) :: (a -> b) -> a -> b$ GenericPackageDescription ::
  PackageDescription
  -> [Flag]
  -> Maybe (CondTree ConfVar [Dependency] Library)
  -> [(String, CondTree ConfVar [Dependency] Executable)]
  -> [(String, CondTree ConfVar [Dependency] TestSuite)]
  -> GenericPackageDescriptionGenericPackageDescription
                   pkg :: PackageDescriptionpkg { sourceRepos = repos :: [SourceRepo]repos }
                   flags :: [Flag]flags mlib :: Maybe (CondTree ConfVar [Dependency] Library)mlib exes :: [Field]exes tests :: [(String, CondTree ConfVar [Dependency] TestSuite)]tests

  where
    oldSyntax flds = all :: (a -> Bool) -> [a] -> Boolall isSimpleField :: Field -> BoolisSimpleField flds :: [Field]flds
    reportTabsError tabs =
        syntaxError :: LineNo -> String -> ParseResult asyntaxError (fst :: (a, b) -> afst (head :: [a] -> ahead tabs :: [(LineNo, b)]tabs)) ($) :: (a -> b) -> a -> b$
          "Do not use tabs for indentation (use spaces instead)\n"
          (++) :: [a] -> [a] -> [a]++ "  Tabs were used at (line,column): " (++) :: [a] -> [a] -> [a]++ show :: Show a => a -> Stringshow tabs :: [(LineNo, b)]tabs

    maybeWarnCabalVersion newsyntax pkg
      | newsyntax :: Boolnewsyntax (&&) :: Bool -> Bool -> Bool&& specVersion :: PackageDescription -> VersionspecVersion pkg :: PackageDescriptionpkg (<) :: Ord a => a -> a -> Bool< Version :: [Int] -> [String] -> VersionVersion [1,2] [] :: [a][]
      = lift :: Monad m => m a -> StT s m alift ($) :: (a -> b) -> a -> b$ warning :: String -> ParseResult ()warning ($) :: (a -> b) -> a -> b$
             "A package using section syntax must specify at least\n"
          (++) :: [a] -> [a] -> [a]++ "'cabal-version: >= 1.2'."

    maybeWarnCabalVersion newsyntax pkg
      | not :: Bool -> Boolnot newsyntax :: Boolnewsyntax (&&) :: Bool -> Bool -> Bool&& specVersion :: PackageDescription -> VersionspecVersion pkg :: PackageDescriptionpkg (>=) :: Ord a => a -> a -> Bool>= Version :: [Int] -> [String] -> VersionVersion [1,2] [] :: [a][]
      = lift :: Monad m => m a -> StT s m alift ($) :: (a -> b) -> a -> b$ warning :: String -> ParseResult ()warning ($) :: (a -> b) -> a -> b$
             "A package using 'cabal-version: "
          (++) :: [a] -> [a] -> [a]++ displaySpecVersion :: Either a VersionRange -> StringdisplaySpecVersion (specVersionRaw :: PackageDescription -> Either Version VersionRangespecVersionRaw pkg :: PackageDescriptionpkg)
          (++) :: [a] -> [a] -> [a]++ "' must use section syntax. See the Cabal user guide for details."
      where
        displaySpecVersion (Left version)       = display :: Text a => a -> Stringdisplay version :: Versionversion
        displaySpecVersion (Right versionRange) =
          case asVersionIntervals :: VersionRange -> [VersionInterval]asVersionIntervals versionRange :: VersionRangeversionRange of
            [] {- impossible -}           -> display :: Text a => a -> Stringdisplay versionRange :: VersionRangeversionRange
            ((LowerBound version _, _):_) -> display :: Text a => a -> Stringdisplay (orLaterVersion :: Version -> VersionRangeorLaterVersion version :: Versionversion)

    maybeWarnCabalVersion _ _ = return :: Monad m => forall a. a -> m areturn ()


    handleFutureVersionParseFailure cabalVersionNeeded parseBody =
      (unless :: Monad m => Bool -> m () -> m ()unless versionOk :: BoolversionOk (warning :: String -> ParseResult ()warning message :: [Char]message) (>>) :: Monad m => forall a b. m a -> m b -> m b>> parseBody :: ParseResult aparseBody)
        catchParseError ::
  ParseResult a -> (PError -> ParseResult a) -> ParseResult a`catchParseError` \parseError -> case parseError :: PErrorparseError of
        TabsError _   -> parseFail :: PError -> ParseResult aparseFail parseError :: PErrorparseError
        _ | versionOk :: BoolversionOk -> parseFail :: PError -> ParseResult aparseFail parseError :: PErrorparseError
          | otherwise :: Boolotherwise -> fail :: Monad m => forall a. String -> m afail message :: [Char]message
      where versionOk = cabalVersionNeeded :: VersioncabalVersionNeeded (<=) :: Ord a => a -> a -> Bool<= cabalVersion :: VersioncabalVersion
            message   = "This package requires at least Cabal version "
                     (++) :: [a] -> [a] -> [a]++ display :: Text a => a -> Stringdisplay cabalVersionNeeded :: VersioncabalVersionNeeded

    -- "Sectionize" an old-style Cabal file.  A sectionized file has:
    --
    --  * all global fields at the beginning, followed by
    --
    --  * all flag declarations, followed by
    --
    --  * an optional library section, and an arbitrary number of executable
    --    sections (in any order).
    --
    -- The current implementatition just gathers all library-specific fields
    -- in a library section and wraps all executable stanzas in an executable
    -- section.
    sectionizeFields :: [Field] -> [Field]
    sectionizeFields fs
      | oldSyntax :: [Field] -> BoololdSyntax fs :: [Field]fs =
          let
            -- "build-depends" is a local field now.  To be backwards
            -- compatible, we still allow it as a global field in old-style
            -- package description files and translate it to a local field by
            -- adding it to every non-empty section
            (hdr0, exes0) = break :: (a -> Bool) -> [a] -> ([a], [a])break (((==) :: Eq a => a -> a -> Bool=="executable") (.) :: (b -> c) -> (a -> b) -> a -> c. fName :: Field -> StringfName) fs :: [Field]fs
            (hdr, libfs0) = partition :: (a -> Bool) -> [a] -> ([a], [a])partition (not :: Bool -> Boolnot (.) :: (b -> c) -> (a -> b) -> a -> c. (elem :: Eq a => a -> [a] -> Bool`elem` libFieldNames :: [String]libFieldNames) (.) :: (b -> c) -> (a -> b) -> a -> c. fName :: Field -> StringfName) hdr0 :: [Field]hdr0

            (deps, libfs) = partition :: (a -> Bool) -> [a] -> ([a], [a])partition (((==) :: Eq a => a -> a -> Bool== "build-depends") (.) :: (b -> c) -> (a -> b) -> a -> c. fName :: Field -> StringfName)
                                       libfs0 :: [Field]libfs0

            exes = unfoldr :: (b -> Maybe (a, b)) -> b -> [a]unfoldr toExe :: [Field] -> Maybe (Field, [Field])toExe exes0 :: [Field]exes0
            toExe [] = Nothing :: Maybe aNothing
            toExe (F l e n : r)
              | e :: Stringe (==) :: Eq a => a -> a -> Bool== "executable" =
                  let (efs, r') = break :: (a -> Bool) -> [a] -> ([a], [a])break (((==) :: Eq a => a -> a -> Bool=="executable") (.) :: (b -> c) -> (a -> b) -> a -> c. fName :: Field -> StringfName) r :: [Field]r
                  in Just :: a -> Maybe aJust (Section :: LineNo -> String -> String -> [Field] -> FieldSection l :: LineNol "executable" n :: Stringn (deps :: [Field]deps (++) :: [a] -> [a] -> [a]++ efs :: [Field]efs), r' :: [Field]r')
            toExe _ = bug :: String -> abug "unexpeced input to 'toExe'"
          in
            hdr :: [Field]hdr (++) :: [a] -> [a] -> [a]++
           (if null :: [a] -> Boolnull libfs :: [Field]libfs then [] :: [a][]
            else [Section :: LineNo -> String -> String -> [Field] -> FieldSection (lineNo :: Field -> LineNolineNo (head :: [a] -> ahead libfs :: [Field]libfs)) "library" "" (deps :: [Field]deps (++) :: [a] -> [a] -> [a]++ libfs :: [Field]libfs)])
            (++) :: [a] -> [a] -> [a]++ exes :: [Field]exes
      | otherwise :: Boolotherwise = fs :: [Field]fs

    isSimpleField (F _ _ _) = True :: BoolTrue
    isSimpleField _ = False :: BoolFalse

    -- warn if there's something at the end of the file
    warnIfRest :: PM ()
    warnIfRest = do
      s <- get :: Monad m => StT s m sget
      case s :: ss of
        [] -> return :: Monad m => forall a. a -> m areturn ()
        _ -> lift :: Monad m => m a -> StT s m alift ($) :: (a -> b) -> a -> b$ warning :: String -> ParseResult ()warning "Ignoring trailing declarations."  -- add line no.

    -- all simple fields at the beginning of the file are (considered) header
    -- fields
    getHeader :: [Field] -> PM [Field]
    getHeader acc = peekField :: PM (Maybe Field)peekField (>>=) :: Monad m => forall a b. m a -> (a -> m b) -> m b>>= \mf -> case mf :: Maybe Fieldmf of
        Just f@(F _ _ _) -> skipField :: PM ()skipField (>>) :: Monad m => forall a b. m a -> m b -> m b>> getHeader :: [Field] -> PM [Field]getHeader (f :: s -> m (a, s)f(:) :: a -> [a] -> [a]:acc :: [Field]acc)
        _ -> return :: Monad m => forall a. a -> m areturn (reverse :: [a] -> [a]reverse acc :: [Field]acc)

    --
    -- body ::= { repo | flag | library | executable | test }+   -- at most one lib
    --
    -- The body consists of an optional sequence of declarations of flags and
    -- an arbitrary number of executables and at most one library.
    getBody :: PM ([SourceRepo], [Flag]
                  ,Maybe (CondTree ConfVar [Dependency] Library)
                  ,[(String, CondTree ConfVar [Dependency] Executable)]
                  ,[(String, CondTree ConfVar [Dependency] TestSuite)])
    getBody = peekField :: PM (Maybe Field)peekField (>>=) :: Monad m => forall a b. m a -> (a -> m b) -> m b>>= \mf -> case mf :: Maybe Fieldmf of
      Just (Section line_no sec_type sec_label sec_fields)
        | sec_type :: Stringsec_type (==) :: Eq a => a -> a -> Bool== "executable" -> do
            when :: Monad m => Bool -> m () -> m ()when (null :: [a] -> Boolnull sec_label :: Stringsec_label) ($) :: (a -> b) -> a -> b$ lift :: Monad m => m a -> StT s m alift ($) :: (a -> b) -> a -> b$ syntaxError :: LineNo -> String -> ParseResult asyntaxError line_no :: LineNoline_no
              "'executable' needs one argument (the executable's name)"
            exename <- lift :: Monad m => m a -> StT s m alift ($) :: (a -> b) -> a -> b$ runP :: LineNo -> String -> ReadP a a -> String -> ParseResult arunP line_no :: LineNoline_no "executable" parseTokenQ :: ReadP r StringparseTokenQ sec_label :: Stringsec_label
            flds <- collectFields ::
  ([Field] -> PM a)
  -> [Field]
  -> PM (CondTree ConfVar [Dependency] a)collectFields parseExeFields :: [Field] -> PM ExecutableparseExeFields sec_fields :: [Field]sec_fields
            skipField :: PM ()skipField
            (repos, flags, lib, exes, tests) <- getBody ::
  PM
    ([SourceRepo],
     [Flag],
     Maybe (CondTree ConfVar [Dependency] Library),
     [(String, CondTree ConfVar [Dependency] Executable)],
     [(String, CondTree ConfVar [Dependency] TestSuite)])getBody
            return :: Monad m => forall a. a -> m areturn (repos :: [SourceRepo]repos, flags :: [Flag]flags, lib :: Librarylib, (exename :: Stringexename, flds :: [Field]flds)(:) :: a -> [a] -> [a]: exes :: [Field]exes, tests :: [(String, CondTree ConfVar [Dependency] TestSuite)]tests)

        | sec_type :: Stringsec_type (==) :: Eq a => a -> a -> Bool== "test-suite" -> do
            when :: Monad m => Bool -> m () -> m ()when (null :: [a] -> Boolnull sec_label :: Stringsec_label) ($) :: (a -> b) -> a -> b$ lift :: Monad m => m a -> StT s m alift ($) :: (a -> b) -> a -> b$ syntaxError :: LineNo -> String -> ParseResult asyntaxError line_no :: LineNoline_no
                "'test-suite' needs one argument (the test suite's name)"
            testname <- lift :: Monad m => m a -> StT s m alift ($) :: (a -> b) -> a -> b$ runP :: LineNo -> String -> ReadP a a -> String -> ParseResult arunP line_no :: LineNoline_no "test" parseTokenQ :: ReadP r StringparseTokenQ sec_label :: Stringsec_label
            flds <- collectFields ::
  ([Field] -> PM a)
  -> [Field]
  -> PM (CondTree ConfVar [Dependency] a)collectFields (parseTestFields :: LineNo -> [Field] -> PM TestSuiteparseTestFields line_no :: LineNoline_no) sec_fields :: [Field]sec_fields

            -- Check that a valid test suite type has been chosen. A type
            -- field may be given inside a conditional block, so we must
            -- check for that before complaining that a type field has not
            -- been given. The test suite must always have a valid type, so
            -- we need to check both the 'then' and 'else' blocks, though
            -- the blocks need not have the same type.
            let checkTestType ts ct =
                    let ts' = mappend :: Monoid a => a -> a -> amappend ts :: TestSuitets ($) :: (a -> b) -> a -> b$ condTreeData :: CondTree v c a -> acondTreeData ct :: CondTree v c TestSuitect
                        -- If a conditional has only a 'then' block and no
                        -- 'else' block, then it cannot have a valid type
                        -- in every branch, unless the type is specified at
                        -- a higher level in the tree.
                        checkComponent (_, _, Nothing) = False :: BoolFalse
                        -- If a conditional has a 'then' block and an 'else'
                        -- block, both must specify a test type, unless the
                        -- type is specified higher in the tree.
                        checkComponent (_, t, Just e) =
                            checkTestType :: TestSuite -> CondTree v c TestSuite -> BoolcheckTestType ts' :: TestSuitets' t :: CondTree v c TestSuitet (&&) :: Bool -> Bool -> Bool&& checkTestType :: TestSuite -> CondTree v c TestSuite -> BoolcheckTestType ts' :: TestSuitets' e :: Stringe
                        -- Does the current node specify a test type?
                        hasTestType = testInterface :: TestSuite -> TestSuiteInterfacetestInterface ts' :: TestSuitets'
                            (/=) :: Eq a => a -> a -> Bool/= testInterface :: TestSuite -> TestSuiteInterfacetestInterface emptyTestSuite :: TestSuiteemptyTestSuite
                        components = condTreeComponents ::
  CondTree v c a
  -> [(Condition v, CondTree v c a, Maybe (CondTree v c a))]condTreeComponents ct :: CondTree v c TestSuitect
                    -- If the current level of the tree specifies a type,
                    -- then we are done. If not, then one of the conditional
                    -- branches below the current node must specify a type.
                    -- Each node may have multiple immediate children; we
                    -- only one need one to specify a type because the
                    -- configure step uses 'mappend' to join together the
                    -- results of flag resolution.
                    in hasTestType :: BoolhasTestType (||) :: Bool -> Bool -> Bool|| (any :: (a -> Bool) -> [a] -> Boolany checkComponent ::
  (t, CondTree v c TestSuite, Maybe (CondTree v c TestSuite)) -> BoolcheckComponent components ::
  [(Condition v,
    CondTree v c TestSuite,
    Maybe (CondTree v c TestSuite))]components)
            if checkTestType :: TestSuite -> CondTree v c TestSuite -> BoolcheckTestType emptyTestSuite :: TestSuiteemptyTestSuite flds :: [Field]flds
                then do
                    skipField :: PM ()skipField
                    (repos, flags, lib, exes, tests) <- getBody ::
  PM
    ([SourceRepo],
     [Flag],
     Maybe (CondTree ConfVar [Dependency] Library),
     [(String, CondTree ConfVar [Dependency] Executable)],
     [(String, CondTree ConfVar [Dependency] TestSuite)])getBody
                    return :: Monad m => forall a. a -> m areturn (repos :: [SourceRepo]repos, flags :: [Flag]flags, lib :: Librarylib, exes :: [Field]exes, (testname :: Stringtestname, flds :: [Field]flds) (:) :: a -> [a] -> [a]: tests :: [(String, CondTree ConfVar [Dependency] TestSuite)]tests)
                else lift :: Monad m => m a -> StT s m alift ($) :: (a -> b) -> a -> b$ syntaxError :: LineNo -> String -> ParseResult asyntaxError line_no :: LineNoline_no ($) :: (a -> b) -> a -> b$
                         "Test suite \"" (++) :: [a] -> [a] -> [a]++ testname :: Stringtestname
                      (++) :: [a] -> [a] -> [a]++ "\" is missing required field \"type\" or the field "
                      (++) :: [a] -> [a] -> [a]++ "is not present in all conditional branches. The "
                      (++) :: [a] -> [a] -> [a]++ "available test types are: "
                      (++) :: [a] -> [a] -> [a]++ intercalate :: [a] -> [[a]] -> [a]intercalate ", " (map :: (a -> b) -> [a] -> [b]map display :: Text a => a -> Stringdisplay knownTestTypes :: [TestType]knownTestTypes)

        | sec_type :: Stringsec_type (==) :: Eq a => a -> a -> Bool== "library" -> do
            when :: Monad m => Bool -> m () -> m ()when (not :: Bool -> Boolnot (null :: [a] -> Boolnull sec_label :: Stringsec_label)) ($) :: (a -> b) -> a -> b$ lift :: Monad m => m a -> StT s m alift ($) :: (a -> b) -> a -> b$
              syntaxError :: LineNo -> String -> ParseResult asyntaxError line_no :: LineNoline_no "'library' expects no argument"
            flds <- collectFields ::
  ([Field] -> PM a)
  -> [Field]
  -> PM (CondTree ConfVar [Dependency] a)collectFields parseLibFields :: [Field] -> PM LibraryparseLibFields sec_fields :: [Field]sec_fields
            skipField :: PM ()skipField
            (repos, flags, lib, exes, tests) <- getBody ::
  PM
    ([SourceRepo],
     [Flag],
     Maybe (CondTree ConfVar [Dependency] Library),
     [(String, CondTree ConfVar [Dependency] Executable)],
     [(String, CondTree ConfVar [Dependency] TestSuite)])getBody
            when :: Monad m => Bool -> m () -> m ()when (isJust :: Maybe a -> BoolisJust lib :: Librarylib) ($) :: (a -> b) -> a -> b$ lift :: Monad m => m a -> StT s m alift ($) :: (a -> b) -> a -> b$ syntaxError :: LineNo -> String -> ParseResult asyntaxError line_no :: LineNoline_no
              "There can only be one library section in a package description."
            return :: Monad m => forall a. a -> m areturn (repos :: [SourceRepo]repos, flags :: [Flag]flags, Just :: a -> Maybe aJust flds :: [Field]flds, exes :: [Field]exes, tests :: [(String, CondTree ConfVar [Dependency] TestSuite)]tests)

        | sec_type :: Stringsec_type (==) :: Eq a => a -> a -> Bool== "flag" -> do
            when :: Monad m => Bool -> m () -> m ()when (null :: [a] -> Boolnull sec_label :: Stringsec_label) ($) :: (a -> b) -> a -> b$ lift :: Monad m => m a -> StT s m alift ($) :: (a -> b) -> a -> b$
              syntaxError :: LineNo -> String -> ParseResult asyntaxError line_no :: LineNoline_no "'flag' needs one argument (the flag's name)"
            flag <- lift :: Monad m => m a -> StT s m alift ($) :: (a -> b) -> a -> b$ parseFields ::
  [FieldDescr a]
  -> UnrecFieldParser a
  -> a
  -> [Field]
  -> ParseResult aparseFields
                    flagFieldDescrs :: [FieldDescr Flag]flagFieldDescrs
                    warnUnrec :: UnrecFieldParser awarnUnrec
                    (MkFlag :: FlagName -> String -> Bool -> Bool -> FlagMkFlag (FlagName :: String -> FlagNameFlagName (lowercase :: String -> Stringlowercase sec_label :: Stringsec_label)) "" True :: BoolTrue False :: BoolFalse)
                    sec_fields :: [Field]sec_fields
            skipField :: PM ()skipField
            (repos, flags, lib, exes, tests) <- getBody ::
  PM
    ([SourceRepo],
     [Flag],
     Maybe (CondTree ConfVar [Dependency] Library),
     [(String, CondTree ConfVar [Dependency] Executable)],
     [(String, CondTree ConfVar [Dependency] TestSuite)])getBody
            return :: Monad m => forall a. a -> m areturn (repos :: [SourceRepo]repos, flag :: Flagflag(:) :: a -> [a] -> [a]:flags :: [Flag]flags, lib :: Librarylib, exes :: [Field]exes, tests :: [(String, CondTree ConfVar [Dependency] TestSuite)]tests)

        | sec_type :: Stringsec_type (==) :: Eq a => a -> a -> Bool== "source-repository" -> do
            when :: Monad m => Bool -> m () -> m ()when (null :: [a] -> Boolnull sec_label :: Stringsec_label) ($) :: (a -> b) -> a -> b$ lift :: Monad m => m a -> StT s m alift ($) :: (a -> b) -> a -> b$ syntaxError :: LineNo -> String -> ParseResult asyntaxError line_no :: LineNoline_no ($) :: (a -> b) -> a -> b$
                 "'source-repository' needs one argument, "
              (++) :: [a] -> [a] -> [a]++ "the repo kind which is usually 'head' or 'this'"
            kind <- case simpleParse :: Text a => String -> Maybe asimpleParse sec_label :: Stringsec_label of
              Just kind -> return :: Monad m => forall a. a -> m areturn kind :: RepoKindkind
              Nothing   -> lift :: Monad m => m a -> StT s m alift ($) :: (a -> b) -> a -> b$ syntaxError :: LineNo -> String -> ParseResult asyntaxError line_no :: LineNoline_no ($) :: (a -> b) -> a -> b$
                             "could not parse repo kind: " (++) :: [a] -> [a] -> [a]++ sec_label :: Stringsec_label
            repo <- lift :: Monad m => m a -> StT s m alift ($) :: (a -> b) -> a -> b$ parseFields ::
  [FieldDescr a]
  -> UnrecFieldParser a
  -> a
  -> [Field]
  -> ParseResult aparseFields
                    sourceRepoFieldDescrs :: [FieldDescr SourceRepo]sourceRepoFieldDescrs
                    warnUnrec :: UnrecFieldParser awarnUnrec
                    (SourceRepo {
                      repoKind     = kind :: RepoKindkind,
                      repoType     = Nothing :: Maybe aNothing,
                      repoLocation = Nothing :: Maybe aNothing,
                      repoModule   = Nothing :: Maybe aNothing,
                      repoBranch   = Nothing :: Maybe aNothing,
                      repoTag      = Nothing :: Maybe aNothing,
                      repoSubdir   = Nothing :: Maybe aNothing
                    })
                    sec_fields :: [Field]sec_fields
            skipField :: PM ()skipField
            (repos, flags, lib, exes, tests) <- getBody ::
  PM
    ([SourceRepo],
     [Flag],
     Maybe (CondTree ConfVar [Dependency] Library),
     [(String, CondTree ConfVar [Dependency] Executable)],
     [(String, CondTree ConfVar [Dependency] TestSuite)])getBody
            return :: Monad m => forall a. a -> m areturn (repo :: SourceReporepo(:) :: a -> [a] -> [a]:repos :: [SourceRepo]repos, flags :: [Flag]flags, lib :: Librarylib, exes :: [Field]exes, tests :: [(String, CondTree ConfVar [Dependency] TestSuite)]tests)

        | otherwise :: Boolotherwise -> do
            lift :: Monad m => m a -> StT s m alift ($) :: (a -> b) -> a -> b$ warning :: String -> ParseResult ()warning ($) :: (a -> b) -> a -> b$ "Ignoring unknown section type: " (++) :: [a] -> [a] -> [a]++ sec_type :: Stringsec_type
            skipField :: PM ()skipField
            getBody ::
  PM
    ([SourceRepo],
     [Flag],
     Maybe (CondTree ConfVar [Dependency] Library),
     [(String, CondTree ConfVar [Dependency] Executable)],
     [(String, CondTree ConfVar [Dependency] TestSuite)])getBody
      Just f -> do
            _ <- lift :: Monad m => m a -> StT s m alift ($) :: (a -> b) -> a -> b$ syntaxError :: LineNo -> String -> ParseResult asyntaxError (lineNo :: Field -> LineNolineNo f :: s -> m (a, s)f) ($) :: (a -> b) -> a -> b$
              "Construct not supported at this position: " (++) :: [a] -> [a] -> [a]++ show :: Show a => a -> Stringshow f :: s -> m (a, s)f
            skipField :: PM ()skipField
            getBody ::
  PM
    ([SourceRepo],
     [Flag],
     Maybe (CondTree ConfVar [Dependency] Library),
     [(String, CondTree ConfVar [Dependency] Executable)],
     [(String, CondTree ConfVar [Dependency] TestSuite)])getBody
      Nothing -> return :: Monad m => forall a. a -> m areturn ([] :: [a][], [] :: [a][], Nothing :: Maybe aNothing, [] :: [a][], [] :: [a][])

    -- Extracts all fields in a block and returns a 'CondTree'.
    --
    -- We have to recurse down into conditionals and we treat fields that
    -- describe dependencies specially.
    collectFields :: ([Field] -> PM a) -> [Field]
                  -> PM (CondTree ConfVar [Dependency] a)
    collectFields parser allflds = do

        let simplFlds = [ F :: LineNo -> String -> String -> FieldF l :: LineNol n :: Stringn v :: Stringv | F l n v <- allflds :: [Field]allflds ]
            condFlds = [ f :: s -> m (a, s)f | f@(IfBlock _ _ _ _) <- allflds :: [Field]allflds ]

        let (depFlds, dataFlds) = partition :: (a -> Bool) -> [a] -> ([a], [a])partition isConstraint :: Field -> BoolisConstraint simplFlds :: [Field]simplFlds

        a <- parser :: [Field] -> PM aparser dataFlds :: [Field]dataFlds
        deps <- liftM :: Monad m => (a1 -> r) -> m a1 -> m rliftM concat :: [[a]] -> [a]concat (.) :: (b -> c) -> (a -> b) -> a -> c. mapM :: Monad m => (a -> m b) -> [a] -> m [b]mapM (lift :: Monad m => m a -> StT s m alift (.) :: (b -> c) -> (a -> b) -> a -> c. parseConstraint :: Field -> ParseResult [Dependency]parseConstraint) ($) :: (a -> b) -> a -> b$ depFlds :: [Field]depFlds

        ifs <- mapM :: Monad m => (a -> m b) -> [a] -> m [b]mapM processIfs ::
  Field
  -> StT
       [Field]
       ParseResult
       (Condition ConfVar,
        CondTree ConfVar [Dependency] a,
        Maybe (CondTree ConfVar [Dependency] a))processIfs condFlds :: [Field]condFlds

        return :: Monad m => forall a. a -> m areturn (CondNode ::
  a
  -> c
  -> [(Condition v, CondTree v c a, Maybe (CondTree v c a))]
  -> CondTree v c aCondNode a :: aa deps :: [Field]deps ifs ::
  [(Condition ConfVar,
    CondTree ConfVar [Dependency] a,
    Maybe (CondTree ConfVar [Dependency] a))]ifs)
      where
        isConstraint (F _ n _) = n :: Stringn elem :: Eq a => a -> [a] -> Bool`elem` constraintFieldNames :: [String]constraintFieldNames
        isConstraint _ = False :: BoolFalse

        processIfs (IfBlock l c t e) = do
            cnd <- lift :: Monad m => m a -> StT s m alift ($) :: (a -> b) -> a -> b$ runP :: LineNo -> String -> ReadP a a -> String -> ParseResult arunP l :: LineNol "if" parseCondition :: ReadP r (Condition ConfVar)parseCondition c :: Stringc
            t' <- collectFields ::
  ([Field] -> PM a)
  -> [Field]
  -> PM (CondTree ConfVar [Dependency] a)collectFields parser :: [Field] -> PM aparser t :: CondTree v c TestSuitet
            e' <- case e :: Stringe of
                   [] -> return :: Monad m => forall a. a -> m areturn Nothing :: Maybe aNothing
                   es -> do fs <- collectFields ::
  ([Field] -> PM a)
  -> [Field]
  -> PM (CondTree ConfVar [Dependency] a)collectFields parser :: [Field] -> PM aparser es :: [Field]es
                            return :: Monad m => forall a. a -> m areturn (Just :: a -> Maybe aJust fs :: [Field]fs)
            return :: Monad m => forall a. a -> m areturn (cnd :: Condition ConfVarcnd, t' :: CondTree ConfVar [Dependency] at', e' :: Maybe (CondTree ConfVar [Dependency] a)e')
        processIfs _ = bug :: String -> abug "processIfs called with wrong field type"

    parseLibFields :: [Field] -> PM Library
    parseLibFields = lift :: Monad m => m a -> StT s m alift (.) :: (b -> c) -> (a -> b) -> a -> c. parseFields ::
  [FieldDescr a]
  -> UnrecFieldParser a
  -> a
  -> [Field]
  -> ParseResult aparseFields libFieldDescrs :: [FieldDescr Library]libFieldDescrs storeXFieldsLib :: UnrecFieldParser LibrarystoreXFieldsLib emptyLibrary :: LibraryemptyLibrary

    -- Note: we don't parse the "executable" field here, hence the tail hack.
    parseExeFields :: [Field] -> PM Executable
    parseExeFields = lift :: Monad m => m a -> StT s m alift (.) :: (b -> c) -> (a -> b) -> a -> c. parseFields ::
  [FieldDescr a]
  -> UnrecFieldParser a
  -> a
  -> [Field]
  -> ParseResult aparseFields (tail :: [a] -> [a]tail executableFieldDescrs :: [FieldDescr Executable]executableFieldDescrs) storeXFieldsExe :: UnrecFieldParser ExecutablestoreXFieldsExe emptyExecutable :: ExecutableemptyExecutable

    parseTestFields :: LineNo -> [Field] -> PM TestSuite
    parseTestFields line fields = do
        x <- lift :: Monad m => m a -> StT s m alift ($) :: (a -> b) -> a -> b$ parseFields ::
  [FieldDescr a]
  -> UnrecFieldParser a
  -> a
  -> [Field]
  -> ParseResult aparseFields testSuiteFieldDescrs :: [FieldDescr TestSuiteStanza]testSuiteFieldDescrs storeXFieldsTest :: UnrecFieldParser TestSuiteStanzastoreXFieldsTest
                                emptyTestStanza :: TestSuiteStanzaemptyTestStanza fields :: [Field]fields
        lift :: Monad m => m a -> StT s m alift ($) :: (a -> b) -> a -> b$ validateTestSuite ::
  LineNo -> TestSuiteStanza -> ParseResult TestSuitevalidateTestSuite line :: LineNoline x :: TestSuiteStanzax

    checkForUndefinedFlags ::
        [Flag] ->
        Maybe (CondTree ConfVar [Dependency] Library) ->
        [(String, CondTree ConfVar [Dependency] Executable)] ->
        [(String, CondTree ConfVar [Dependency] TestSuite)] ->
        PM ()
    checkForUndefinedFlags flags mlib exes tests = do
        let definedFlags = map :: (a -> b) -> [a] -> [b]map flagName :: Flag -> FlagNameflagName flags :: [Flag]flags
        maybe :: b -> (a -> b) -> Maybe a -> bmaybe (return :: Monad m => forall a. a -> m areturn ()) (checkCondTreeFlags :: [FlagName] -> CondTree ConfVar c a -> PM ()checkCondTreeFlags definedFlags :: [FlagName]definedFlags) mlib :: Maybe (CondTree ConfVar [Dependency] Library)mlib
        mapM_ :: Monad m => (a -> m b) -> [a] -> m ()mapM_ (checkCondTreeFlags :: [FlagName] -> CondTree ConfVar c a -> PM ()checkCondTreeFlags definedFlags :: [FlagName]definedFlags (.) :: (b -> c) -> (a -> b) -> a -> c. snd :: (a, b) -> bsnd) exes :: [Field]exes
        mapM_ :: Monad m => (a -> m b) -> [a] -> m ()mapM_ (checkCondTreeFlags :: [FlagName] -> CondTree ConfVar c a -> PM ()checkCondTreeFlags definedFlags :: [FlagName]definedFlags (.) :: (b -> c) -> (a -> b) -> a -> c. snd :: (a, b) -> bsnd) tests :: [(String, CondTree ConfVar [Dependency] TestSuite)]tests

    checkCondTreeFlags :: [FlagName] -> CondTree ConfVar c a -> PM ()
    checkCondTreeFlags definedFlags ct = do
        let fv = nub :: Eq a => [a] -> [a]nub ($) :: (a -> b) -> a -> b$ freeVars :: CondTree ConfVar c a -> [FlagName]freeVars ct :: CondTree v c TestSuitect
        when :: Monad m => Bool -> m () -> m ()when (not :: Bool -> Boolnot (.) :: (b -> c) -> (a -> b) -> a -> c. all :: (a -> Bool) -> [a] -> Boolall (elem :: Eq a => a -> [a] -> Bool`elem` definedFlags :: [FlagName]definedFlags) ($) :: (a -> b) -> a -> b$ fv :: [FlagName]fv) ($) :: (a -> b) -> a -> b$
            fail :: Monad m => forall a. String -> m afail ($) :: (a -> b) -> a -> b$ "These flags are used without having been defined: "
                (++) :: [a] -> [a] -> [a]++ intercalate :: [a] -> [[a]] -> [a]intercalate ", " [ n :: Stringn | FlagName n <- fv :: [FlagName]fv (\\) :: Eq a => [a] -> [a] -> [a]\\ definedFlags :: [FlagName]definedFlags ]


-- | Parse a list of fields, given a list of field descriptions,
--   a structure to accumulate the parsed fields, and a function
--   that can decide what to do with fields which don't match any
--   of the field descriptions.
parseFields :: [FieldDescr a]      -- ^ descriptions of fields we know how to
                                   --   parse
            -> UnrecFieldParser a  -- ^ possibly do something with
                                   --   unrecognized fields
            -> a                   -- ^ accumulator
            -> [Field]             -- ^ fields to be parsed
            -> ParseResult a
parseFields descrs unrec ini fields =
    do (a, unknowns) <- foldM :: Monad m => (a -> b -> m a) -> a -> [b] -> m afoldM (parseField ::
  [FieldDescr a]
  -> UnrecFieldParser a
  -> (a, [(Int, String)])
  -> Field
  -> ParseResult (a, [(Int, String)])parseField descrs :: [FieldDescr a]descrs unrec :: UnrecFieldParser aunrec) (ini :: aini, [] :: [a][]) fields :: [Field]fields
       when :: Monad m => Bool -> m () -> m ()when (not :: Bool -> Boolnot (null :: [a] -> Boolnull unknowns :: [(Int, String)]unknowns)) ($) :: (a -> b) -> a -> b$ do
         warning :: String -> ParseResult ()warning ($) :: (a -> b) -> a -> b$ render :: Doc -> Stringrender ($) :: (a -> b) -> a -> b$
           text :: String -> Doctext "Unknown fields:" (<+>) :: Doc -> Doc -> Doc<+>
                commaSep :: [String] -> DoccommaSep (map :: (a -> b) -> [a] -> [b]map (\(l,u) -> u :: [Char]u (++) :: [a] -> [a] -> [a]++ " (line " (++) :: [a] -> [a] -> [a]++ show :: Show a => a -> Stringshow l :: LineNol (++) :: [a] -> [a] -> [a]++ ")")
                              (reverse :: [a] -> [a]reverse unknowns :: [(Int, String)]unknowns))
           ($+$) :: Doc -> Doc -> Doc$+$
           text :: String -> Doctext "Fields allowed in this section:" ($$) :: Doc -> Doc -> Doc$$
             nest :: Int -> Doc -> Docnest 4 (commaSep :: [String] -> DoccommaSep ($) :: (a -> b) -> a -> b$ map :: (a -> b) -> [a] -> [b]map fieldName :: FieldDescr a -> StringfieldName descrs :: [FieldDescr a]descrs)
       return :: Monad m => forall a. a -> m areturn a :: aa
  where
    commaSep = fsep :: [Doc] -> Docfsep (.) :: (b -> c) -> (a -> b) -> a -> c. punctuate :: Doc -> [Doc] -> [Doc]punctuate comma :: Doccomma (.) :: (b -> c) -> (a -> b) -> a -> c. map :: (a -> b) -> [a] -> [b]map text :: String -> Doctext

parseField :: [FieldDescr a]     -- ^ list of parseable fields
           -> UnrecFieldParser a -- ^ possibly do something with
                                 --   unrecognized fields
           -> (a,[(Int,String)]) -- ^ accumulated result and warnings
           -> Field              -- ^ the field to be parsed
           -> ParseResult (a, [(Int,String)])
parseField ((FieldDescr name _ parser):fields) unrec (a, us) (F line f val)
  | name :: PackageNamename (==) :: Eq a => a -> a -> Bool== f :: s -> m (a, s)f = parser :: [Field] -> PM aparser line :: LineNoline val :: [FilePath]val a :: aa (>>=) :: Monad m => forall a b. m a -> (a -> m b) -> m b>>= \a' -> return :: Monad m => forall a. a -> m areturn (a' :: aa',us :: [(Int, String)]us)
  | otherwise :: Boolotherwise = parseField ::
  [FieldDescr a]
  -> UnrecFieldParser a
  -> (a, [(Int, String)])
  -> Field
  -> ParseResult (a, [(Int, String)])parseField fields :: [Field]fields unrec :: UnrecFieldParser aunrec (a :: aa,us :: [(Int, String)]us) (F :: LineNo -> String -> String -> FieldF line :: LineNoline f :: s -> m (a, s)f val :: [FilePath]val)
parseField [] unrec (a,us) (F l f val) = return :: Monad m => forall a. a -> m areturn ($) :: (a -> b) -> a -> b$
  case unrec :: UnrecFieldParser aunrec (f :: s -> m (a, s)f,val :: [FilePath]val) a :: aa of        -- no fields matched, see if the 'unrec'
    Just a' -> (a' :: aa',us :: [(Int, String)]us)           -- function wants to do anything with it
    Nothing -> (a :: aa, ((l :: LineNol,f :: s -> m (a, s)f)(:) :: a -> [a] -> [a]:us :: [(Int, String)]us))
parseField _ _ _ _ = bug :: String -> abug "'parseField' called on a non-field"

deprecatedFields :: [(String,String)]
deprecatedFields =
    deprecatedFieldsPkgDescr :: [(String, String)]deprecatedFieldsPkgDescr (++) :: [a] -> [a] -> [a]++ deprecatedFieldsBuildInfo :: [(String, String)]deprecatedFieldsBuildInfo

deprecatedFieldsPkgDescr :: [(String,String)]
deprecatedFieldsPkgDescr = [ ("other-files", "extra-source-files") ]

deprecatedFieldsBuildInfo :: [(String,String)]
deprecatedFieldsBuildInfo = [ ("hs-source-dir","hs-source-dirs") ]

-- Handle deprecated fields
deprecField :: Field -> ParseResult Field
deprecField (F line fld val) = do
  fld' <- case lookup :: Eq a => a -> [(a, b)] -> Maybe blookup fld :: Fieldfld deprecatedFields :: [(String, String)]deprecatedFields of
            Nothing -> return :: Monad m => forall a. a -> m areturn fld :: Fieldfld
            Just newName -> do
              warning :: String -> ParseResult ()warning ($) :: (a -> b) -> a -> b$ "The field \"" (++) :: [a] -> [a] -> [a]++ fld :: Fieldfld
                      (++) :: [a] -> [a] -> [a]++ "\" is deprecated, please use \"" (++) :: [a] -> [a] -> [a]++ newName :: StringnewName (++) :: [a] -> [a] -> [a]++ "\""
              return :: Monad m => forall a. a -> m areturn newName :: StringnewName
  return :: Monad m => forall a. a -> m areturn (F :: LineNo -> String -> String -> FieldF line :: LineNoline fld' :: Stringfld' val :: [FilePath]val)
deprecField _ = bug :: String -> abug "'deprecField' called on a non-field"


parseHookedBuildInfo :: String -> ParseResult HookedBuildInfo
parseHookedBuildInfo inp = do
  fields <- readFields :: String -> ParseResult [Field]readFields inp :: Stringinp
  let ss@(mLibFields:exes) = stanzas :: [Field] -> [[Field]]stanzas fields :: [Field]fields
  mLib <- parseLib :: [Field] -> ParseResult (Maybe BuildInfo)parseLib mLibFields :: [Field]mLibFields
  biExes <- mapM :: Monad m => (a -> m b) -> [a] -> m [b]mapM parseExe :: [Field] -> ParseResult (String, BuildInfo)parseExe (maybe :: b -> (a -> b) -> Maybe a -> bmaybe ss :: [[Field]]ss (const :: a -> b -> aconst exes :: [Field]exes) mLib :: Maybe BuildInfomLib)
  return :: Monad m => forall a. a -> m areturn (mLib :: Maybe BuildInfomLib, biExes :: [(String, BuildInfo)]biExes)
  where
    parseLib :: [Field] -> ParseResult (Maybe BuildInfo)
    parseLib (bi@((F _ inFieldName _):_))
        | lowercase :: String -> Stringlowercase inFieldName :: StringinFieldName (/=) :: Eq a => a -> a -> Bool/= "executable" = liftM :: Monad m => (a1 -> r) -> m a1 -> m rliftM Just :: a -> Maybe aJust (parseBI :: [Field] -> ParseResult BuildInfoparseBI bi :: BuildInfobi)
    parseLib _ = return :: Monad m => forall a. a -> m areturn Nothing :: Maybe aNothing

    parseExe :: [Field] -> ParseResult (String, BuildInfo)
    parseExe ((F line inFieldName mName):bi)
        | lowercase :: String -> Stringlowercase inFieldName :: StringinFieldName (==) :: Eq a => a -> a -> Bool== "executable"
            = do bis <- parseBI :: [Field] -> ParseResult BuildInfoparseBI bi :: BuildInfobi
                 return :: Monad m => forall a. a -> m areturn (mName :: StringmName, bis :: BuildInfobis)
        | otherwise :: Boolotherwise = syntaxError :: LineNo -> String -> ParseResult asyntaxError line :: LineNoline "expecting 'executable' at top of stanza"
    parseExe (_:_) = bug :: String -> abug "`parseExe' called on a non-field"
    parseExe [] = syntaxError :: LineNo -> String -> ParseResult asyntaxError 0 "error in parsing buildinfo file. Expected executable stanza"

    parseBI st = parseFields ::
  [FieldDescr a]
  -> UnrecFieldParser a
  -> a
  -> [Field]
  -> ParseResult aparseFields binfoFieldDescrs :: [FieldDescr BuildInfo]binfoFieldDescrs storeXFieldsBI :: UnrecFieldParser BuildInfostoreXFieldsBI emptyBuildInfo :: BuildInfoemptyBuildInfo st :: [Field]st

-- ---------------------------------------------------------------------------
-- Pretty printing

writePackageDescription :: FilePath -> PackageDescription -> IO ()
writePackageDescription fpath pkg = writeUTF8File :: FilePath -> String -> IO ()writeUTF8File fpath :: FilePathfpath (showPackageDescription :: PackageDescription -> StringshowPackageDescription pkg :: PackageDescriptionpkg)

--TODO: make this use section syntax
-- add equivalent for GenericPackageDescription
showPackageDescription :: PackageDescription -> String
showPackageDescription pkg = render :: Doc -> Stringrender ($) :: (a -> b) -> a -> b$
     ppPackage :: PackageDescription -> DocppPackage pkg :: PackageDescriptionpkg
  ($$) :: Doc -> Doc -> Doc$$ ppCustomFields :: [(String, String)] -> DocppCustomFields (customFieldsPD :: PackageDescription -> [(String, String)]customFieldsPD pkg :: PackageDescriptionpkg)
  ($$) :: Doc -> Doc -> Doc$$ (case library :: PackageDescription -> Maybe Librarylibrary pkg :: PackageDescriptionpkg of
        Nothing  -> empty :: Docempty
        Just lib -> ppLibrary :: Library -> DocppLibrary lib :: Librarylib)
  ($$) :: Doc -> Doc -> Doc$$ vcat :: [Doc] -> Docvcat [ space :: Docspace ($$) :: Doc -> Doc -> Doc$$ ppExecutable :: Executable -> DocppExecutable exe :: Executableexe | exe <- executables :: PackageDescription -> [Executable]executables pkg :: PackageDescriptionpkg ]
  where
    ppPackage    = ppFields :: [FieldDescr a] -> a -> DocppFields pkgDescrFieldDescrs :: [FieldDescr PackageDescription]pkgDescrFieldDescrs
    ppLibrary    = ppFields :: [FieldDescr a] -> a -> DocppFields libFieldDescrs :: [FieldDescr Library]libFieldDescrs
    ppExecutable = ppFields :: [FieldDescr a] -> a -> DocppFields executableFieldDescrs :: [FieldDescr Executable]executableFieldDescrs

ppCustomFields :: [(String,String)] -> Doc
ppCustomFields flds = vcat :: [Doc] -> Docvcat (map :: (a -> b) -> [a] -> [b]map ppCustomField :: (String, String) -> DocppCustomField flds :: [Field]flds)

ppCustomField :: (String,String) -> Doc
ppCustomField (name,val) = text :: String -> Doctext name :: PackageNamename (<>) :: Doc -> Doc -> Doc<> colon :: Doccolon (<+>) :: Doc -> Doc -> Doc<+> showFreeText :: String -> DocshowFreeText val :: [FilePath]val

writeHookedBuildInfo :: FilePath -> HookedBuildInfo -> IO ()
writeHookedBuildInfo fpath = writeFileAtomic :: FilePath -> String -> IO ()writeFileAtomic fpath :: FilePathfpath (.) :: (b -> c) -> (a -> b) -> a -> c. showHookedBuildInfo :: HookedBuildInfo -> StringshowHookedBuildInfo

showHookedBuildInfo :: HookedBuildInfo -> String
showHookedBuildInfo (mb_lib_bi, ex_bis) = render :: Doc -> Stringrender ($) :: (a -> b) -> a -> b$
     (case mb_lib_bi :: Maybe BuildInfomb_lib_bi of
        Nothing -> empty :: Docempty
        Just bi -> ppBuildInfo :: BuildInfo -> DocppBuildInfo bi :: BuildInfobi)
  ($$) :: Doc -> Doc -> Doc$$ vcat :: [Doc] -> Docvcat [    space :: Docspace
            ($$) :: Doc -> Doc -> Doc$$ text :: String -> Doctext "executable:" (<+>) :: Doc -> Doc -> Doc<+> text :: String -> Doctext name :: PackageNamename
            ($$) :: Doc -> Doc -> Doc$$ ppBuildInfo :: BuildInfo -> DocppBuildInfo bi :: BuildInfobi
          | (name, bi) <- ex_bis :: [(String, BuildInfo)]ex_bis ]
  where
    ppBuildInfo bi = ppFields :: [FieldDescr a] -> a -> DocppFields binfoFieldDescrs :: [FieldDescr BuildInfo]binfoFieldDescrs bi :: BuildInfobi
                  ($$) :: Doc -> Doc -> Doc$$ ppCustomFields :: [(String, String)] -> DocppCustomFields (customFieldsBI :: BuildInfo -> [(String, String)]customFieldsBI bi :: BuildInfobi)

-- replace all tabs used as indentation with whitespace, also return where
-- tabs were found
findIndentTabs :: String -> [(Int,Int)]
findIndentTabs = concatMap :: (a -> [b]) -> [a] -> [b]concatMap checkLine :: (t, [Char]) -> [(t, t)]checkLine
               (.) :: (b -> c) -> (a -> b) -> a -> c. zip :: [a] -> [b] -> [(a, b)]zip [1..]
               (.) :: (b -> c) -> (a -> b) -> a -> c. lines :: String -> [String]lines
    where
      checkLine (lineno, l) =
          let (indent, _content) = span :: (a -> Bool) -> [a] -> ([a], [a])span isSpace :: Char -> BoolisSpace l :: LineNol
              tabCols = map :: (a -> b) -> [a] -> [b]map fst :: (a, b) -> afst (.) :: (b -> c) -> (a -> b) -> a -> c. filter :: (a -> Bool) -> [a] -> [a]filter (((==) :: Eq a => a -> a -> Bool== '\t') (.) :: (b -> c) -> (a -> b) -> a -> c. snd :: (a, b) -> bsnd) (.) :: (b -> c) -> (a -> b) -> a -> c. zip :: [a] -> [b] -> [(a, b)]zip [0..]
              addLineNo = map :: (a -> b) -> [a] -> [b]map (\col -> (lineno :: tlineno,col :: tcol))
          in addLineNo :: [t] -> [(t, t)]addLineNo (tabCols :: [Char] -> [t]tabCols indent :: [Char]indent)

--test_findIndentTabs = findIndentTabs $ unlines $
--    [ "foo", "  bar", " \t baz", "\t  biz\t", "\t\t \t mib" ]

bug :: String -> a
bug msg = error :: [Char] -> aerror ($) :: (a -> b) -> a -> b$ msg :: Stringmsg (++) :: [a] -> [a] -> [a]++ ". Consider this a bug."