-----------------------------------------------------------------------------
-- |
-- Module      :  Distribution.ParseUtils
-- Copyright   :  (c) The University of Glasgow 2004
--
-- Maintainer  :  cabal-devel@haskell.org
-- Portability :  portable
--
-- Utilities for parsing 'PackageDescription' and 'InstalledPackageInfo'.
--
-- The @.cabal@ file format is not trivial, especially with the introduction
-- of configurations and the section syntax that goes with that. This module
-- has a bunch of parsing functions that is used by the @.cabal@ parser and a
-- couple others. It has the parsing framework code and also little parsers for
-- many of the formats we get in various @.cabal@ file fields, like module
-- names, comma separated lists etc.

{- 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 the University 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. -}

-- This module is meant to be local-only to Distribution...

-- #hide
module Distribution.ParseUtils (
        LineNo, PError(..), PWarning(..), locatedErrorMsg, syntaxError, warning,
        runP, runE, ParseResult(..), catchParseError, parseFail, showPWarning,
        Field(..), fName, lineNo,
        FieldDescr(..), ppField, ppFields, readFields, readFieldsFlat,
        showFields, showSingleNamedField, parseFields, parseFieldsFlat,
        parseFilePathQ, parseTokenQ, parseTokenQ',
        parseModuleNameQ, parseBuildTool, parsePkgconfigDependency,
        parseOptVersion, parsePackageNameQ, parseVersionRangeQ,
        parseTestedWithQ, parseLicenseQ, parseLanguageQ, parseExtensionQ,
        parseSepList, parseCommaList, parseOptCommaList,
        showFilePath, showToken, showTestedWith, showFreeText, parseFreeText,
        field, simpleField, listField, spaceListField, commaListField,
        optsField, liftField, boolField, parseQuoted,

        UnrecFieldParser, warnUnrec, ignoreUnrec,
  ) where

import Distribution.Compiler (CompilerFlavor, parseCompilerFlavorCompat)
import Distribution.License
import Distribution.Version
         ( Version(..), VersionRange, anyVersion )
import Distribution.Package     ( PackageName(..), Dependency(..) )
import Distribution.ModuleName (ModuleName)
import Distribution.Compat.ReadP as ReadP hiding (get)
import Distribution.ReadE
import Distribution.Text
         ( Text(..) )
import Distribution.Simple.Utils
         ( comparing, intercalate, lowercase, normaliseLineEndings )
import Language.Haskell.Extension
         ( Language, Extension )

import Text.PrettyPrint.HughesPJ hiding (braces)
import Data.Char (isSpace, toLower, isAlphaNum, isDigit)
import Data.Maybe       (fromMaybe)
import Data.Tree as Tree (Tree(..), flatten)
import qualified Data.Map as Map
import Control.Monad (foldM)
import System.FilePath (normalise)
import Data.List (sortBy)

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

type LineNo = Int

data PError = AmbigousParse String LineNo
            | NoParse String LineNo
            | TabsError LineNo
            | FromString String (Maybe LineNo)
        deriving D:Show ::
  (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> T:Show aShow

data PWarning = PWarning String
              | UTFWarning LineNo String
        deriving D:Show ::
  (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> T:Show aShow

showPWarning :: FilePath -> PWarning -> String
showPWarning fpath (PWarning msg) =
  normalise :: FilePath -> FilePathnormalise fpath :: FilePathfpath (++) :: [a] -> [a] -> [a]++ ": " (++) :: [a] -> [a] -> [a]++ msg :: Stringmsg
showPWarning fpath (UTFWarning line fname) =
  normalise :: FilePath -> FilePathnormalise fpath :: FilePathfpath (++) :: [a] -> [a] -> [a]++ ":" (++) :: [a] -> [a] -> [a]++ show :: Show a => a -> Stringshow line :: LineNoline
        (++) :: [a] -> [a] -> [a]++ ": Invalid UTF-8 text in the '" (++) :: [a] -> [a] -> [a]++ fname :: Stringfname (++) :: [a] -> [a] -> [a]++ "' field."

data ParseResult a = ParseFailed PError | ParseOk [PWarning] a
        deriving D:Show ::
  (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> T:Show aShow

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 ParseResult where
        return x = ParseOk :: [PWarning] -> a -> ParseResult aParseOk [] :: [a][] x :: ax
        ParseFailed err >>= _ = ParseFailed :: PError -> ParseResult aParseFailed err :: PErrorerr
        ParseOk ws x >>= f = case f :: a -> ParseResult bf x :: ax of
                               ParseFailed err -> ParseFailed :: PError -> ParseResult aParseFailed err :: PErrorerr
                               ParseOk ws' x' -> ParseOk :: [PWarning] -> a -> ParseResult aParseOk (ws' :: [PWarning]ws'(++) :: [a] -> [a] -> [a]++ws :: [PWarning]ws) x' :: bx'
        fail s = ParseFailed :: PError -> ParseResult aParseFailed (FromString :: String -> Maybe LineNo -> PErrorFromString s :: Strings Nothing :: Maybe aNothing)

catchParseError :: ParseResult a -> (PError -> ParseResult a)
                -> ParseResult a
p@(ParseOk _ _) `catchParseError` _ = p :: ParseResult ap
ParseFailed e `catchParseError` k   = k :: PError -> ParseResult ak e :: PErrore

parseFail :: PError -> ParseResult a
parseFail = ParseFailed :: PError -> ParseResult aParseFailed

runP :: LineNo -> String -> ReadP a a -> String -> ParseResult a
runP line fieldname p s =
  case [ x :: ax | (x,"") <- results :: [(a, String)]results ] of
    [a] -> ParseOk :: [PWarning] -> a -> ParseResult aParseOk (utf8Warnings :: LineNo -> String -> String -> [PWarning]utf8Warnings line :: LineNoline fieldname :: Stringfieldname s :: Strings) a :: Fielda
    --TODO: what is this double parse thing all about?
    --      Can't we just do the all isSpace test the first time?
    []  -> case [ x :: ax | (x,ys) <- results :: [(a, String)]results, all :: (a -> Bool) -> [a] -> Boolall isSpace :: Char -> BoolisSpace ys :: Stringys ] of
             [a] -> ParseOk :: [PWarning] -> a -> ParseResult aParseOk (utf8Warnings :: LineNo -> String -> String -> [PWarning]utf8Warnings line :: LineNoline fieldname :: Stringfieldname s :: Strings) a :: Fielda
             []  -> ParseFailed :: PError -> ParseResult aParseFailed (NoParse :: String -> LineNo -> PErrorNoParse fieldname :: Stringfieldname line :: LineNoline)
             _   -> ParseFailed :: PError -> ParseResult aParseFailed (AmbigousParse :: String -> LineNo -> PErrorAmbigousParse fieldname :: Stringfieldname line :: LineNoline)
    _   -> ParseFailed :: PError -> ParseResult aParseFailed (AmbigousParse :: String -> LineNo -> PErrorAmbigousParse fieldname :: Stringfieldname line :: LineNoline)
  where results = readP_to_S :: ReadP a a -> ReadS areadP_to_S p :: ParseResult ap s :: Strings

runE :: LineNo -> String -> ReadE a -> String -> ParseResult a
runE line fieldname p s =
    case runReadE :: ReadE a -> String -> Either ErrorMsg arunReadE p :: ParseResult ap s :: Strings of
      Right a -> ParseOk :: [PWarning] -> a -> ParseResult aParseOk (utf8Warnings :: LineNo -> String -> String -> [PWarning]utf8Warnings line :: LineNoline fieldname :: Stringfieldname s :: Strings) a :: Fielda
      Left  e -> syntaxError :: LineNo -> String -> ParseResult asyntaxError line :: LineNoline ($) :: (a -> b) -> a -> b$
        "Parse of field '" (++) :: [a] -> [a] -> [a]++ fieldname :: Stringfieldname (++) :: [a] -> [a] -> [a]++ "' failed (" (++) :: [a] -> [a] -> [a]++ e :: PErrore (++) :: [a] -> [a] -> [a]++ "): " (++) :: [a] -> [a] -> [a]++ s :: Strings

utf8Warnings :: LineNo -> String -> String -> [PWarning]
utf8Warnings line fieldname s =
  take :: Int -> [a] -> [a]take 1 [ UTFWarning :: LineNo -> String -> PWarningUTFWarning n :: LineNon fieldname :: Stringfieldname
         | (n,l) <- zip :: [a] -> [b] -> [(a, b)]zip [line :: LineNoline..] (lines :: String -> [String]lines s :: Strings)
         , '\xfffd' elem :: Eq a => a -> [a] -> Bool`elem` l :: [(a, [[a]])]l ]

locatedErrorMsg :: PError -> (Maybe LineNo, String)
locatedErrorMsg (AmbigousParse f n) = (Just :: a -> Maybe aJust n :: LineNon, "Ambiguous parse in field '"(++) :: [a] -> [a] -> [a]++f :: a -> ParseResult bf(++) :: [a] -> [a] -> [a]++"'.")
locatedErrorMsg (NoParse f n)       = (Just :: a -> Maybe aJust n :: LineNon, "Parse of field '"(++) :: [a] -> [a] -> [a]++f :: a -> ParseResult bf(++) :: [a] -> [a] -> [a]++"' failed.")
locatedErrorMsg (TabsError n)       = (Just :: a -> Maybe aJust n :: LineNon, "Tab used as indentation.")
locatedErrorMsg (FromString s n)    = (n :: LineNon, s :: Strings)

syntaxError :: LineNo -> String -> ParseResult a
syntaxError n s = ParseFailed :: PError -> ParseResult aParseFailed ($) :: (a -> b) -> a -> b$ FromString :: String -> Maybe LineNo -> PErrorFromString s :: Strings (Just :: a -> Maybe aJust n :: LineNon)

tabsError :: LineNo -> ParseResult a
tabsError ln = ParseFailed :: PError -> ParseResult aParseFailed ($) :: (a -> b) -> a -> b$ TabsError :: LineNo -> PErrorTabsError ln :: LineNoln

warning :: String -> ParseResult ()
warning s = ParseOk :: [PWarning] -> a -> ParseResult aParseOk [PWarning :: String -> PWarningPWarning s :: Strings] ()

-- | Field descriptor.  The parameter @a@ parameterizes over where the field's
--   value is stored in.
data fieldSet :: LineNo -> String -> a -> ParseResult aFieldDescr a
  = FieldDescr
      { fieldName     :: String
      , fieldGet      :: a -> Doc
      , fieldSet      :: LineNo -> String -> a -> ParseResult a
        -- ^ @fieldSet n str x@ Parses the field value from the given input
        -- string @str@ and stores the result in @x@ if the parse was
        -- successful.  Otherwise, reports an error on line number @n@.
      }

field :: String -> (a -> Doc) -> (ReadP a a) -> FieldDescr a
field name showF readF =
  FieldDescr ::
  String
  -> (a -> Doc)
  -> (LineNo -> String -> a -> ParseResult a)
  -> FieldDescr aFieldDescr name :: Stringname showF :: a -> DocshowF (\line val _st -> runP :: LineNo -> String -> ReadP a a -> String -> ParseResult arunP line :: LineNoline name :: Stringname readF :: ReadP [a] areadF val :: Stringval)

-- Lift a field descriptor storing into an 'a' to a field descriptor storing
-- into a 'b'.
liftField :: (b -> a) -> (a -> b -> b) -> FieldDescr a -> FieldDescr b
liftField get set (FieldDescr name showF parseF)
 = FieldDescr ::
  String
  -> (a -> Doc)
  -> (LineNo -> String -> a -> ParseResult a)
  -> FieldDescr aFieldDescr name :: Stringname (\b -> showF :: a -> DocshowF (get :: b -> [(CompilerFlavor, [String])]get b :: Fieldb))
        (\line str b -> do
            a <- parseF :: LineNo -> String -> a -> ParseResult aparseF line :: LineNoline str :: Stringstr (get :: b -> [(CompilerFlavor, [String])]get b :: Fieldb)
            return :: Monad m => forall a. a -> m areturn (set :: [(CompilerFlavor, [String])] -> b -> bset a :: Fielda b :: Fieldb))

-- Parser combinator for simple fields.  Takes a field name, a pretty printer,
-- a parser function, an accessor, and a setter, returns a FieldDescr over the
-- compoid structure.
simpleField :: String -> (a -> Doc) -> (ReadP a a)
            -> (b -> a) -> (a -> b -> b) -> FieldDescr b
simpleField name showF readF get set
  = liftField ::
  (b -> a) -> (a -> b -> b) -> FieldDescr a -> FieldDescr bliftField get :: b -> [(CompilerFlavor, [String])]get set :: [(CompilerFlavor, [String])] -> b -> bset ($) :: (a -> b) -> a -> b$ field :: String -> (a -> Doc) -> ReadP a a -> FieldDescr afield name :: Stringname showF :: a -> DocshowF readF :: ReadP [a] areadF

commaListField :: String -> (a -> Doc) -> (ReadP [a] a)
                 -> (b -> [a]) -> ([a] -> b -> b) -> FieldDescr b
commaListField name showF readF get set =
  liftField ::
  (b -> a) -> (a -> b -> b) -> FieldDescr a -> FieldDescr bliftField get :: b -> [(CompilerFlavor, [String])]get set' :: [a] -> b -> bset' ($) :: (a -> b) -> a -> b$
    field :: String -> (a -> Doc) -> ReadP a a -> FieldDescr afield name :: Stringname (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 showF :: a -> DocshowF) (parseCommaList :: ReadP r a -> ReadP r [a]parseCommaList readF :: ReadP [a] areadF)
  where
    set' xs b = set :: [(CompilerFlavor, [String])] -> b -> bset (get :: b -> [(CompilerFlavor, [String])]get b :: Fieldb (++) :: [a] -> [a] -> [a]++ xs :: [a]xs) b :: Fieldb

spaceListField :: String -> (a -> Doc) -> (ReadP [a] a)
                 -> (b -> [a]) -> ([a] -> b -> b) -> FieldDescr b
spaceListField name showF readF get set =
  liftField ::
  (b -> a) -> (a -> b -> b) -> FieldDescr a -> FieldDescr bliftField get :: b -> [(CompilerFlavor, [String])]get set' :: [a] -> b -> bset' ($) :: (a -> b) -> a -> b$
    field :: String -> (a -> Doc) -> ReadP a a -> FieldDescr afield name :: Stringname (fsep :: [Doc] -> Docfsep (.) :: (b -> c) -> (a -> b) -> a -> c. map :: (a -> b) -> [a] -> [b]map showF :: a -> DocshowF) (parseSpaceList :: ReadP r a -> ReadP r [a]parseSpaceList readF :: ReadP [a] areadF)
  where
    set' xs b = set :: [(CompilerFlavor, [String])] -> b -> bset (get :: b -> [(CompilerFlavor, [String])]get b :: Fieldb (++) :: [a] -> [a] -> [a]++ xs :: [a]xs) b :: Fieldb

listField :: String -> (a -> Doc) -> (ReadP [a] a)
                 -> (b -> [a]) -> ([a] -> b -> b) -> FieldDescr b
listField name showF readF get set =
  liftField ::
  (b -> a) -> (a -> b -> b) -> FieldDescr a -> FieldDescr bliftField get :: b -> [(CompilerFlavor, [String])]get set' :: [a] -> b -> bset' ($) :: (a -> b) -> a -> b$
    field :: String -> (a -> Doc) -> ReadP a a -> FieldDescr afield name :: Stringname (fsep :: [Doc] -> Docfsep (.) :: (b -> c) -> (a -> b) -> a -> c. map :: (a -> b) -> [a] -> [b]map showF :: a -> DocshowF) (parseOptCommaList :: ReadP r a -> ReadP r [a]parseOptCommaList readF :: ReadP [a] areadF)
  where
    set' xs b = set :: [(CompilerFlavor, [String])] -> b -> bset (get :: b -> [(CompilerFlavor, [String])]get b :: Fieldb (++) :: [a] -> [a] -> [a]++ xs :: [a]xs) b :: Fieldb

optsField :: String -> CompilerFlavor -> (b -> [(CompilerFlavor,[String])]) -> ([(CompilerFlavor,[String])] -> b -> b) -> FieldDescr b
optsField name flavor get set =
   liftField ::
  (b -> a) -> (a -> b -> b) -> FieldDescr a -> FieldDescr bliftField (fromMaybe :: a -> Maybe a -> afromMaybe [] :: [a][] (.) :: (b -> c) -> (a -> b) -> a -> c. lookup :: Eq a => a -> [(a, b)] -> Maybe blookup flavor :: CompilerFlavorflavor (.) :: (b -> c) -> (a -> b) -> a -> c. get :: b -> [(CompilerFlavor, [String])]get)
             (\opts b -> set :: [(CompilerFlavor, [String])] -> b -> bset (reorder :: [(CompilerFlavor, b)] -> [(CompilerFlavor, b)]reorder (update :: a -> [[a]] -> [(a, [[a]])] -> [(a, [[a]])]update flavor :: CompilerFlavorflavor opts :: [[a]]opts (get :: b -> [(CompilerFlavor, [String])]get b :: Fieldb))) b :: Fieldb) ($) :: (a -> b) -> a -> b$
        field :: String -> (a -> Doc) -> ReadP a a -> FieldDescr afield name :: Stringname (hsep :: [Doc] -> Dochsep (.) :: (b -> c) -> (a -> b) -> a -> c. map :: (a -> b) -> [a] -> [b]map text :: String -> Doctext)
                   (sepBy :: ReadP r a -> ReadP r sep -> ReadP r [a]sepBy parseTokenQ' :: ReadP r StringparseTokenQ' (munch1 :: (Char -> Bool) -> ReadP r Stringmunch1 isSpace :: Char -> BoolisSpace))
  where
        update _ opts l | all :: (a -> Bool) -> [a] -> Boolall null :: [a] -> Boolnull opts :: [[a]]opts = l :: [(a, [[a]])]l  --empty opts as if no opts
        update f opts [] = [(f :: a -> ParseResult bf,opts :: [[a]]opts)]
        update f opts ((f',opts'):rest)
           | f :: a -> ParseResult bf (==) :: Eq a => a -> a -> Bool== f' :: af'   = (f :: a -> ParseResult bf, opts' :: [[a]]opts' (++) :: [a] -> [a] -> [a]++ opts :: [[a]]opts) (:) :: a -> [a] -> [a]: rest :: [(a, [[a]])]rest
           | otherwise :: Boolotherwise = (f' :: af',opts' :: [[a]]opts') (:) :: a -> [a] -> [a]: update :: a -> [[a]] -> [(a, [[a]])] -> [(a, [[a]])]update f :: a -> ParseResult bf opts :: [[a]]opts rest :: [(a, [[a]])]rest
        reorder = sortBy :: (a -> a -> Ordering) -> [a] -> [a]sortBy (comparing :: Ord a => (b -> a) -> b -> b -> Orderingcomparing fst :: (a, b) -> afst)

-- TODO: this is a bit smelly hack. It's because we want to parse bool fields
--       liberally but not accept new parses. We cannot do that with ReadP
--       because it does not support warnings. We need a new parser framwork!
boolField :: String -> (b -> Bool) -> (Bool -> b -> b) -> FieldDescr b
boolField name get set = liftField ::
  (b -> a) -> (a -> b -> b) -> FieldDescr a -> FieldDescr bliftField get :: b -> [(CompilerFlavor, [String])]get set :: [(CompilerFlavor, [String])] -> b -> bset (FieldDescr ::
  String
  -> (a -> Doc)
  -> (LineNo -> String -> a -> ParseResult a)
  -> FieldDescr aFieldDescr name :: Stringname showF :: a -> DocshowF readF :: ReadP [a] areadF)
  where
    showF = text :: String -> Doctext (.) :: (b -> c) -> (a -> b) -> a -> c. show :: Show a => a -> Stringshow
    readF line str _
      |  str :: Stringstr (==) :: Eq a => a -> a -> Bool== "True"  = ParseOk :: [PWarning] -> a -> ParseResult aParseOk [] :: [a][] True :: BoolTrue
      |  str :: Stringstr (==) :: Eq a => a -> a -> Bool== "False" = ParseOk :: [PWarning] -> a -> ParseResult aParseOk [] :: [a][] False :: BoolFalse
      | lstr :: Stringlstr (==) :: Eq a => a -> a -> Bool== "true"  = ParseOk :: [PWarning] -> a -> ParseResult aParseOk [caseWarning :: PWarningcaseWarning] True :: BoolTrue
      | lstr :: Stringlstr (==) :: Eq a => a -> a -> Bool== "false" = ParseOk :: [PWarning] -> a -> ParseResult aParseOk [caseWarning :: PWarningcaseWarning] False :: BoolFalse
      | otherwise :: Boolotherwise       = ParseFailed :: PError -> ParseResult aParseFailed (NoParse :: String -> LineNo -> PErrorNoParse name :: Stringname line :: LineNoline)
      where
        lstr = lowercase :: String -> Stringlowercase str :: Stringstr
        caseWarning = PWarning :: String -> PWarningPWarning ($) :: (a -> b) -> a -> b$
          "The '" (++) :: [a] -> [a] -> [a]++ name :: Stringname (++) :: [a] -> [a] -> [a]++ "' field is case sensitive, use 'True' or 'False'."

ppFields :: [FieldDescr a] -> a -> Doc
ppFields fields x = vcat :: [Doc] -> Docvcat [ ppField :: String -> Doc -> DocppField name :: Stringname (getter :: a -> Docgetter x :: ax)
                         | FieldDescr name getter _ <- fields :: [FieldDescr a]fields]

ppField :: String -> Doc -> Doc
ppField name fielddoc = text :: String -> Doctext name :: Stringname (<>) :: Doc -> Doc -> Doc<> colon :: Doccolon (<+>) :: Doc -> Doc -> Doc<+> fielddoc :: Docfielddoc

showFields :: [FieldDescr a] -> a -> String
showFields fields = render :: Doc -> Stringrender (.) :: (b -> c) -> (a -> b) -> a -> c. (($+$) :: Doc -> Doc -> Doc$+$ text :: String -> Doctext "") (.) :: (b -> c) -> (a -> b) -> a -> c. ppFields :: [FieldDescr a] -> a -> DocppFields fields :: [FieldDescr a]fields

showSingleNamedField :: [FieldDescr a] -> String -> Maybe (a -> String)
showSingleNamedField fields f =
  case [ get :: b -> [(CompilerFlavor, [String])]get | (FieldDescr f' get _) <- fields :: [FieldDescr a]fields, f' :: af' (==) :: Eq a => a -> a -> Bool== f :: a -> ParseResult bf ] of
    []      -> Nothing :: Maybe aNothing
    (get:_) -> Just :: a -> Maybe aJust (render :: Doc -> Stringrender (.) :: (b -> c) -> (a -> b) -> a -> c. ppField :: String -> Doc -> DocppField f :: a -> ParseResult bf (.) :: (b -> c) -> (a -> b) -> a -> c. get :: b -> [(CompilerFlavor, [String])]get)

parseFields :: [FieldDescr a] -> a -> String -> ParseResult a
parseFields fields initial = \str ->
  readFields :: String -> ParseResult [Field]readFields str :: Stringstr (>>=) :: Monad m => forall a b. m a -> (a -> m b) -> m b>>= accumFields :: [FieldDescr a] -> a -> [Field] -> ParseResult aaccumFields fields :: [FieldDescr a]fields initial :: ainitial

parseFieldsFlat :: [FieldDescr a] -> a -> String -> ParseResult a
parseFieldsFlat fields initial = \str ->
  readFieldsFlat :: String -> ParseResult [Field]readFieldsFlat str :: Stringstr (>>=) :: Monad m => forall a b. m a -> (a -> m b) -> m b>>= accumFields :: [FieldDescr a] -> a -> [Field] -> ParseResult aaccumFields fields :: [FieldDescr a]fields initial :: ainitial

accumFields :: [FieldDescr a] -> a -> [Field] -> ParseResult a
accumFields fields = foldM :: Monad m => (a -> b -> m a) -> a -> [b] -> m afoldM setField :: a -> Field -> ParseResult asetField
  where
    fieldMap = fromList :: Ord k => [(k, a)] -> Map k aMap.fromList
      [ (name :: Stringname, f :: a -> ParseResult bf) | f@(FieldDescr name _ _) <- fields :: [FieldDescr a]fields ]
    setField accum (F line name value) = case lookup :: Ord k => k -> Map k a -> Maybe aMap.lookup name :: Stringname fieldMap :: Map String (FieldDescr a)fieldMap of
      Just (FieldDescr _ _ set) -> set :: [(CompilerFlavor, [String])] -> b -> bset line :: LineNoline value :: Stringvalue accum :: aaccum
      Nothing -> do
        warning :: String -> ParseResult ()warning ("Unrecognized field " (++) :: [a] -> [a] -> [a]++ name :: Stringname (++) :: [a] -> [a] -> [a]++ " on line " (++) :: [a] -> [a] -> [a]++ show :: Show a => a -> Stringshow line :: LineNoline)
        return :: Monad m => forall a. a -> m areturn accum :: aaccum
    setField accum f = do
      warning :: String -> ParseResult ()warning ("Unrecognized stanza on line " (++) :: [a] -> [a] -> [a]++ show :: Show a => a -> Stringshow (lineNo :: Field -> LineNolineNo f :: a -> ParseResult bf))
      return :: Monad m => forall a. a -> m areturn accum :: aaccum

-- | The type of a function which, given a name-value pair of an
--   unrecognized field, and the current structure being built,
--   decides whether to incorporate the unrecognized field
--   (by returning  Just x, where x is a possibly modified version
--   of the structure being built), or not (by returning Nothing).
type UnrecFieldParser a = (String,String) -> a -> Maybe a

-- | A default unrecognized field parser which simply returns Nothing,
--   i.e. ignores all unrecognized fields, so warnings will be generated.
warnUnrec :: UnrecFieldParser a
warnUnrec _ _ = Nothing :: Maybe aNothing

-- | A default unrecognized field parser which silently (i.e. no
--   warnings will be generated) ignores unrecognized fields, by
--   returning the structure being built unmodified.
ignoreUnrec :: UnrecFieldParser a
ignoreUnrec _ x = Just :: a -> Maybe aJust x :: ax

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

-- The data type for our three syntactic categories
data Field
    = F LineNo String String
      -- ^ A regular @<property>: <value>@ field
    | Section LineNo String String [Field]
      -- ^ A section with a name and possible parameter.  The syntactic
      -- structure is:
      --
      -- @
      --   <sectionname> <arg> {
      --     <field>*
      --   }
      -- @
    | IfBlock LineNo String [Field] [Field]
      -- ^ A conditional block with an optional else branch:
      --
      -- @
      --  if <condition> {
      --    <field>*
      --  } else {
      --    <field>*
      --  }
      -- @
      deriving (D:Show ::
  (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> T:Show aShow
               ,D:Eq :: (a -> a -> Bool) -> (a -> a -> Bool) -> T:Eq aEq)   -- for testing

lineNo :: Field -> LineNo
lineNo (F n _ _) = n :: LineNon
lineNo (Section n _ _ _) = n :: LineNon
lineNo (IfBlock n _ _ _) = n :: LineNon

fName :: Field -> String
fName (F _ n _) = n :: LineNon
fName (Section _ n _ _) = n :: LineNon
fName _ = error :: [Char] -> aerror "fname: not a field or section"

readFields :: String -> ParseResult [Field]
readFields input = ifelse :: [Field] -> ParseResult [Field]ifelse
               (=<<) :: Monad m => (a -> m b) -> m a -> m b=<< mapM :: Monad m => (a -> m b) -> [a] -> m [b]mapM (mkField :: Int -> SyntaxTree -> ParseResult FieldmkField 0)
               (=<<) :: Monad m => (a -> m b) -> m a -> m b=<< mkTree :: [Token] -> ParseResult [SyntaxTree]mkTree tokens :: [Token]tokens

  where ls = (lines :: String -> [String]lines (.) :: (b -> c) -> (a -> b) -> a -> c. normaliseLineEndings :: String -> StringnormaliseLineEndings) input :: Stringinput
        tokens = (concatMap :: (a -> [b]) -> [a] -> [b]concatMap tokeniseLine :: (LineNo, Indent, HasTabs, String) -> [Token]tokeniseLine (.) :: (b -> c) -> (a -> b) -> a -> c. trimLines :: [String] -> [(LineNo, Indent, HasTabs, String)]trimLines) ls :: [String]ls

readFieldsFlat :: String -> ParseResult [Field]
readFieldsFlat input = mapM :: Monad m => (a -> m b) -> [a] -> m [b]mapM (mkField :: Int -> SyntaxTree -> ParseResult FieldmkField 0)
                   (=<<) :: Monad m => (a -> m b) -> m a -> m b=<< mkTree :: [Token] -> ParseResult [SyntaxTree]mkTree tokens :: [Token]tokens
  where ls = (lines :: String -> [String]lines (.) :: (b -> c) -> (a -> b) -> a -> c. normaliseLineEndings :: String -> StringnormaliseLineEndings) input :: Stringinput
        tokens = (concatMap :: (a -> [b]) -> [a] -> [b]concatMap tokeniseLineFlat :: (LineNo, Indent, HasTabs, String) -> [Token]tokeniseLineFlat (.) :: (b -> c) -> (a -> b) -> a -> c. trimLines :: [String] -> [(LineNo, Indent, HasTabs, String)]trimLines) ls :: [String]ls

-- attach line number and determine indentation
trimLines :: [String] -> [(LineNo, Indent, HasTabs, String)]
trimLines ls = [ (lineno :: LineNolineno, indent :: Intindent, hastabs :: Boolhastabs, (trimTrailing :: String -> StringtrimTrailing l' :: [Char]l'))
               | (lineno, l) <- zip :: [a] -> [b] -> [(a, b)]zip [1..] ls :: [String]ls
               , let (sps, l') = span :: (a -> Bool) -> [a] -> ([a], [a])span isSpace :: Char -> BoolisSpace l :: [(a, [[a]])]l
                     indent    = length :: [a] -> Intlength sps :: [Char]sps
                     hastabs   = '\t' elem :: Eq a => a -> [a] -> Bool`elem` sps :: [Char]sps
               , validLine :: [Char] -> BoolvalidLine l' :: [Char]l' ]
  where validLine ('-':'-':_) = False :: BoolFalse      -- Comment
        validLine []          = False :: BoolFalse      -- blank line
        validLine _           = True :: BoolTrue

-- | We parse generically based on indent level and braces '{' '}'. To do that
-- we split into lines and then '{' '}' tokens and other spans within a line.
data Token =
       -- | The 'Line' token is for bits that /start/ a line, eg:
       --
       -- > "\n  blah blah { blah"
       --
       -- tokenises to:
       --
       -- > [Line n 2 False "blah blah", OpenBracket, Span n "blah"]
       --
       -- so lines are the only ones that can have nested layout, since they
       -- have a known indentation level.
       --
       -- eg: we can't have this:
       --
       -- > if ... {
       -- > } else
       -- >     other
       --
       -- because other cannot nest under else, since else doesn't start a line
       -- so cannot have nested layout. It'd have to be:
       --
       -- > if ... {
       -- > }
       -- >   else
       -- >     other
       --
       -- but that's not so common, people would normally use layout or
       -- brackets not both in a single @if else@ construct.
       --
       -- > if ... { foo : bar }
       -- > else
       -- >    other
       --
       -- this is ok
       Line LineNo Indent HasTabs String
     | Span LineNo                String  -- ^ span in a line, following brackets
     | OpenBracket LineNo | CloseBracket LineNo

type Indent = Int
type HasTabs = Bool

-- | Tokenise a single line, splitting on '{' '}' and the spans inbetween.
-- Also trims leading & trailing space on those spans within the line.
tokeniseLine :: (LineNo, Indent, HasTabs, String) -> [Token]
tokeniseLine (n0, i, t, l) = case split :: LineNo -> [Char] -> [Token]split n0 :: LineNon0 l :: [(a, [[a]])]l of
                            (Span _ l':ss) -> Line :: LineNo -> Indent -> HasTabs -> String -> TokenLine n0 :: LineNon0 i :: Indenti t :: HasTabst l' :: [Char]l' (:) :: a -> [a] -> [a]:ss :: [Token]ss
                            cs              -> cs :: [Token]cs
  where split _ "" = [] :: [a][]
        split n s  = case span :: (a -> Bool) -> [a] -> ([a], [a])span (\c -> c :: Charc (/=) :: Eq a => a -> a -> Bool/='}' (&&) :: Bool -> Bool -> Bool&& c :: Charc (/=) :: Eq a => a -> a -> Bool/= '{') s :: Strings of
          ("", '{' : s') ->             OpenBracket :: LineNo -> TokenOpenBracket  n :: LineNon (:) :: a -> [a] -> [a]: split :: LineNo -> [Char] -> [Token]split n :: LineNon s' :: [Char]s'
          (w , '{' : s') -> mkspan :: LineNo -> String -> [Token] -> [Token]mkspan n :: LineNon w :: [Char]w (OpenBracket :: LineNo -> TokenOpenBracket  n :: LineNon (:) :: a -> [a] -> [a]: split :: LineNo -> [Char] -> [Token]split n :: LineNon s' :: [Char]s')
          ("", '}' : s') ->             CloseBracket :: LineNo -> TokenCloseBracket n :: LineNon (:) :: a -> [a] -> [a]: split :: LineNo -> [Char] -> [Token]split n :: LineNon s' :: [Char]s'
          (w , '}' : s') -> mkspan :: LineNo -> String -> [Token] -> [Token]mkspan n :: LineNon w :: [Char]w (CloseBracket :: LineNo -> TokenCloseBracket n :: LineNon (:) :: a -> [a] -> [a]: split :: LineNo -> [Char] -> [Token]split n :: LineNon s' :: [Char]s')
          (w ,        _) -> mkspan :: LineNo -> String -> [Token] -> [Token]mkspan n :: LineNon w :: [Char]w [] :: [a][]

        mkspan n s ss | null :: [a] -> Boolnull s' :: [Char]s'   =             ss :: [Token]ss
                      | otherwise :: Boolotherwise = Span :: LineNo -> String -> TokenSpan n :: LineNon s' :: [Char]s' (:) :: a -> [a] -> [a]: ss :: [Token]ss
          where s' = trimTrailing :: String -> StringtrimTrailing (trimLeading :: String -> StringtrimLeading s :: Strings)

tokeniseLineFlat :: (LineNo, Indent, HasTabs, String) -> [Token]
tokeniseLineFlat (n0, i, t, l)
  | null :: [a] -> Boolnull l' :: [Char]l'   = [] :: [a][]
  | otherwise :: Boolotherwise = [Line :: LineNo -> Indent -> HasTabs -> String -> TokenLine n0 :: LineNon0 i :: Indenti t :: HasTabst l' :: [Char]l']
  where
    l' = trimTrailing :: String -> StringtrimTrailing (trimLeading :: String -> StringtrimLeading l :: [(a, [[a]])]l)

trimLeading, trimTrailing :: String -> String
trimLeading  = dropWhile :: (a -> Bool) -> [a] -> [a]dropWhile isSpace :: Char -> BoolisSpace
trimTrailing = reverse :: [a] -> [a]reverse (.) :: (b -> c) -> (a -> b) -> a -> c. dropWhile :: (a -> Bool) -> [a] -> [a]dropWhile isSpace :: Char -> BoolisSpace (.) :: (b -> c) -> (a -> b) -> a -> c. reverse :: [a] -> [a]reverse


type SyntaxTree = Tree (LineNo, HasTabs, String)

-- | Parse the stream of tokens into a tree of them, based on indent \/ layout
mkTree :: [Token] -> ParseResult [SyntaxTree]
mkTree toks =
  layout ::
  Indent
  -> [SyntaxTree]
  -> [Token]
  -> ParseResult ([SyntaxTree], [Token])layout 0 [] :: [a][] toks :: [Token]toks (>>=) :: Monad m => forall a b. m a -> (a -> m b) -> m b>>= \(trees, trailing) -> case trailing :: [Token]trailing of
    []               -> return :: Monad m => forall a. a -> m areturn trees :: [SyntaxTree]trees
    OpenBracket  n:_ -> syntaxError :: LineNo -> String -> ParseResult asyntaxError n :: LineNon "mismatched backets, unexpected {"
    CloseBracket n:_ -> syntaxError :: LineNo -> String -> ParseResult asyntaxError n :: LineNon "mismatched backets, unexpected }"
    -- the following two should never happen:
    Span n     l  :_ -> syntaxError :: LineNo -> String -> ParseResult asyntaxError n :: LineNon ($) :: (a -> b) -> a -> b$ "unexpected span: " (++) :: [a] -> [a] -> [a]++ show :: Show a => a -> Stringshow l :: [(a, [[a]])]l
    Line n _ _ l  :_ -> syntaxError :: LineNo -> String -> ParseResult asyntaxError n :: LineNon ($) :: (a -> b) -> a -> b$ "unexpected line: " (++) :: [a] -> [a] -> [a]++ show :: Show a => a -> Stringshow l :: [(a, [[a]])]l


-- | Parse the stream of tokens into a tree of them, based on indent
-- This parse state expect to be in a layout context, though possibly
-- nested within a braces context so we may still encounter closing braces.
layout :: Indent       -- ^ indent level of the parent\/previous line
       -> [SyntaxTree] -- ^ accumulating param, trees in this level
       -> [Token]      -- ^ remaining tokens
       -> ParseResult ([SyntaxTree], [Token])
                       -- ^ collected trees on this level and trailing tokens
layout _ a []                               = return :: Monad m => forall a. a -> m areturn (reverse :: [a] -> [a]reverse a :: Fielda, [] :: [a][])
layout i a (s@(Line _ i' _ _):ss) | i' :: Indenti' (<) :: Ord a => a -> a -> Bool< i :: Indenti  = return :: Monad m => forall a. a -> m areturn (reverse :: [a] -> [a]reverse a :: Fielda, s :: Strings(:) :: a -> [a] -> [a]:ss :: [Token]ss)
layout i a (Line n _ t l:OpenBracket n':ss) = do
    (sub, ss') <- braces ::
  LineNo
  -> [SyntaxTree]
  -> [Token]
  -> ParseResult ([SyntaxTree], [Token])braces n' :: LineNon' [] :: [a][] ss :: [Token]ss
    layout ::
  Indent
  -> [SyntaxTree]
  -> [Token]
  -> ParseResult ([SyntaxTree], [Token])layout i :: Indenti (Node :: a -> Forest a -> Tree aNode (n :: LineNon,t :: HasTabst,l :: [(a, [[a]])]l) sub :: [SyntaxTree]sub(:) :: a -> [a] -> [a]:a :: Fielda) ss' :: [Token]ss'

layout i a (Span n     l:OpenBracket n':ss) = do
    (sub, ss') <- braces ::
  LineNo
  -> [SyntaxTree]
  -> [Token]
  -> ParseResult ([SyntaxTree], [Token])braces n' :: LineNon' [] :: [a][] ss :: [Token]ss
    layout ::
  Indent
  -> [SyntaxTree]
  -> [Token]
  -> ParseResult ([SyntaxTree], [Token])layout i :: Indenti (Node :: a -> Forest a -> Tree aNode (n :: LineNon,False :: BoolFalse,l :: [(a, [[a]])]l) sub :: [SyntaxTree]sub(:) :: a -> [a] -> [a]:a :: Fielda) ss' :: [Token]ss'

-- look ahead to see if following lines are more indented, giving a sub-tree
layout i a (Line n i' t l:ss) = do
    lookahead <- layout ::
  Indent
  -> [SyntaxTree]
  -> [Token]
  -> ParseResult ([SyntaxTree], [Token])layout (i' :: Indenti'(+) :: Num a => a -> a -> a+1) [] :: [a][] ss :: [Token]ss
    case lookahead :: ([SyntaxTree], [Token])lookahead of
        ([], _)   -> layout ::
  Indent
  -> [SyntaxTree]
  -> [Token]
  -> ParseResult ([SyntaxTree], [Token])layout i :: Indenti (Node :: a -> Forest a -> Tree aNode (n :: LineNon,t :: HasTabst,l :: [(a, [[a]])]l) [] :: [a][] (:) :: a -> [a] -> [a]:a :: Fielda) ss :: [Token]ss
        (ts, ss') -> layout ::
  Indent
  -> [SyntaxTree]
  -> [Token]
  -> ParseResult ([SyntaxTree], [Token])layout i :: Indenti (Node :: a -> Forest a -> Tree aNode (n :: LineNon,t :: HasTabst,l :: [(a, [[a]])]l) ts :: Forest (LineNo, HasTabs, String)ts (:) :: a -> [a] -> [a]:a :: Fielda) ss' :: [Token]ss'

layout _ _ (   OpenBracket  n :_)  = syntaxError :: LineNo -> String -> ParseResult asyntaxError n :: LineNon ($) :: (a -> b) -> a -> b$ "unexpected '{'"
layout _ a (s@(CloseBracket _):ss) = return :: Monad m => forall a. a -> m areturn (reverse :: [a] -> [a]reverse a :: Fielda, s :: Strings(:) :: a -> [a] -> [a]:ss :: [Token]ss)
layout _ _ (   Span n l       : _) = syntaxError :: LineNo -> String -> ParseResult asyntaxError n :: LineNon ($) :: (a -> b) -> a -> b$ "unexpected span: "
                                                  (++) :: [a] -> [a] -> [a]++ show :: Show a => a -> Stringshow l :: [(a, [[a]])]l

-- | Parse the stream of tokens into a tree of them, based on explicit braces
-- This parse state expects to find a closing bracket.
braces :: LineNo       -- ^ line of the '{', used for error messages
       -> [SyntaxTree] -- ^ accumulating param, trees in this level
       -> [Token]      -- ^ remaining tokens
       -> ParseResult ([SyntaxTree],[Token])
                       -- ^ collected trees on this level and trailing tokens
braces m a (Line n _ t l:OpenBracket n':ss) = do
    (sub, ss') <- braces ::
  LineNo
  -> [SyntaxTree]
  -> [Token]
  -> ParseResult ([SyntaxTree], [Token])braces n' :: LineNon' [] :: [a][] ss :: [Token]ss
    braces ::
  LineNo
  -> [SyntaxTree]
  -> [Token]
  -> ParseResult ([SyntaxTree], [Token])braces m :: LineNom (Node :: a -> Forest a -> Tree aNode (n :: LineNon,t :: HasTabst,l :: [(a, [[a]])]l) sub :: [SyntaxTree]sub(:) :: a -> [a] -> [a]:a :: Fielda) ss' :: [Token]ss'

braces m a (Span n     l:OpenBracket n':ss) = do
    (sub, ss') <- braces ::
  LineNo
  -> [SyntaxTree]
  -> [Token]
  -> ParseResult ([SyntaxTree], [Token])braces n' :: LineNon' [] :: [a][] ss :: [Token]ss
    braces ::
  LineNo
  -> [SyntaxTree]
  -> [Token]
  -> ParseResult ([SyntaxTree], [Token])braces m :: LineNom (Node :: a -> Forest a -> Tree aNode (n :: LineNon,False :: BoolFalse,l :: [(a, [[a]])]l) sub :: [SyntaxTree]sub(:) :: a -> [a] -> [a]:a :: Fielda) ss' :: [Token]ss'

braces m a (Line n i t l:ss) = do
    lookahead <- layout ::
  Indent
  -> [SyntaxTree]
  -> [Token]
  -> ParseResult ([SyntaxTree], [Token])layout (i :: Indenti(+) :: Num a => a -> a -> a+1) [] :: [a][] ss :: [Token]ss
    case lookahead :: ([SyntaxTree], [Token])lookahead of
        ([], _)   -> braces ::
  LineNo
  -> [SyntaxTree]
  -> [Token]
  -> ParseResult ([SyntaxTree], [Token])braces m :: LineNom (Node :: a -> Forest a -> Tree aNode (n :: LineNon,t :: HasTabst,l :: [(a, [[a]])]l) [] :: [a][] (:) :: a -> [a] -> [a]:a :: Fielda) ss :: [Token]ss
        (ts, ss') -> braces ::
  LineNo
  -> [SyntaxTree]
  -> [Token]
  -> ParseResult ([SyntaxTree], [Token])braces m :: LineNom (Node :: a -> Forest a -> Tree aNode (n :: LineNon,t :: HasTabst,l :: [(a, [[a]])]l) ts :: Forest (LineNo, HasTabs, String)ts (:) :: a -> [a] -> [a]:a :: Fielda) ss' :: [Token]ss'

braces m a (Span n       l:ss) = braces ::
  LineNo
  -> [SyntaxTree]
  -> [Token]
  -> ParseResult ([SyntaxTree], [Token])braces m :: LineNom (Node :: a -> Forest a -> Tree aNode (n :: LineNon,False :: BoolFalse,l :: [(a, [[a]])]l) [] :: [a][](:) :: a -> [a] -> [a]:a :: Fielda) ss :: [Token]ss
braces _ a (CloseBracket _:ss) = return :: Monad m => forall a. a -> m areturn (reverse :: [a] -> [a]reverse a :: Fielda, ss :: [Token]ss)
braces n _ []                  = syntaxError :: LineNo -> String -> ParseResult asyntaxError n :: LineNon ($) :: (a -> b) -> a -> b$ "opening brace '{'"
                              (++) :: [a] -> [a] -> [a]++ "has no matching closing brace '}'"
braces _ _ (OpenBracket  n:_)  = syntaxError :: LineNo -> String -> ParseResult asyntaxError n :: LineNon "unexpected '{'"

-- | Convert the parse tree into the Field AST
-- Also check for dodgy uses of tabs in indentation.
mkField :: Int -> SyntaxTree -> ParseResult Field
mkField d (Node (n,t,_) _) | d :: Intd (>=) :: Ord a => a -> a -> Bool>= 1 (&&) :: Bool -> Bool -> Bool&& t :: HasTabst = tabsError :: LineNo -> ParseResult atabsError n :: LineNon
mkField d (Node (n,_,l) ts) = case span :: (a -> Bool) -> [a] -> ([a], [a])span (\c -> isAlphaNum :: Char -> BoolisAlphaNum c :: Charc (||) :: Bool -> Bool -> Bool|| c :: Charc (==) :: Eq a => a -> a -> Bool== '-') l :: [(a, [[a]])]l of
  ([], _)       -> syntaxError :: LineNo -> String -> ParseResult asyntaxError n :: LineNon ($) :: (a -> b) -> a -> b$ "unrecognised field or section: " (++) :: [a] -> [a] -> [a]++ show :: Show a => a -> Stringshow l :: [(a, [[a]])]l
  (name, rest)  -> case trimLeading :: String -> StringtrimLeading rest :: [(a, [[a]])]rest of
    (':':rest') -> do let followingLines = concatMap :: (a -> [b]) -> [a] -> [b]concatMap flatten :: Tree a -> [a]Tree.flatten ts :: Forest (LineNo, HasTabs, String)ts
                          tabs = not :: Bool -> Boolnot (null :: [a] -> Boolnull [()| (_,True,_) <- followingLines :: [(t, t, [Char])]followingLines ])
                      if tabs :: Booltabs (&&) :: Bool -> Bool -> Bool&& d :: Intd (>=) :: Ord a => a -> a -> Bool>= 1
                        then tabsError :: LineNo -> ParseResult atabsError n :: LineNon
                        else return :: Monad m => forall a. a -> m areturn ($) :: (a -> b) -> a -> b$ F :: LineNo -> String -> String -> FieldF n :: LineNon (map :: (a -> b) -> [a] -> [b]map toLower :: Char -> ChartoLower name :: Stringname)
                                          (fieldValue :: String -> [(t, t, [Char])] -> [Char]fieldValue rest' :: Stringrest' followingLines :: [(t, t, [Char])]followingLines)
    rest'       -> do ts' <- mapM :: Monad m => (a -> m b) -> [a] -> m [b]mapM (mkField :: Int -> SyntaxTree -> ParseResult FieldmkField (d :: Intd(+) :: Num a => a -> a -> a+1)) ts :: Forest (LineNo, HasTabs, String)ts
                      return :: Monad m => forall a. a -> m areturn (Section :: LineNo -> String -> String -> [Field] -> FieldSection n :: LineNon (map :: (a -> b) -> [a] -> [b]map toLower :: Char -> ChartoLower name :: Stringname) rest' :: Stringrest' ts' :: [Field]ts')
 where    fieldValue firstLine followingLines =
            let firstLine' = trimLeading :: String -> StringtrimLeading firstLine :: StringfirstLine
                followingLines' = map :: (a -> b) -> [a] -> [b]map (\(_,_,s) -> stripDot :: [Char] -> [Char]stripDot s :: Strings) followingLines :: [(t, t, [Char])]followingLines
                allLines | null :: [a] -> Boolnull firstLine' :: StringfirstLine' =              followingLines' :: [[Char]]followingLines'
                         | otherwise :: Boolotherwise       = firstLine' :: StringfirstLine' (:) :: a -> [a] -> [a]: followingLines' :: [[Char]]followingLines'
             in intercalate :: [a] -> [[a]] -> [a]intercalate "\n" allLines :: [[Char]]allLines
          stripDot "." = ""
          stripDot s   = s :: Strings

-- | Convert if/then/else 'Section's to 'IfBlock's
ifelse :: [Field] -> ParseResult [Field]
ifelse [] = return :: Monad m => forall a. a -> m areturn [] :: [a][]
ifelse (Section n "if"   cond thenpart
       :Section _ "else" as   elsepart:fs)
       | null :: [a] -> Boolnull cond :: Stringcond     = syntaxError :: LineNo -> String -> ParseResult asyntaxError n :: LineNon "'if' with missing condition"
       | null :: [a] -> Boolnull thenpart :: [Field]thenpart = syntaxError :: LineNo -> String -> ParseResult asyntaxError n :: LineNon "'then' branch of 'if' is empty"
       | not :: Bool -> Boolnot (null :: [a] -> Boolnull as :: Stringas) = syntaxError :: LineNo -> String -> ParseResult asyntaxError n :: LineNon "'else' takes no arguments"
       | null :: [a] -> Boolnull elsepart :: [Field]elsepart = syntaxError :: LineNo -> String -> ParseResult asyntaxError n :: LineNon "'else' branch of 'if' is empty"
       | otherwise :: Boolotherwise     = do tp  <- ifelse :: [Field] -> ParseResult [Field]ifelse thenpart :: [Field]thenpart
                            ep  <- ifelse :: [Field] -> ParseResult [Field]ifelse elsepart :: [Field]elsepart
                            fs' <- ifelse :: [Field] -> ParseResult [Field]ifelse fs :: [Field]fs
                            return :: Monad m => forall a. a -> m areturn (IfBlock :: LineNo -> String -> [Field] -> [Field] -> FieldIfBlock n :: LineNon cond :: Stringcond tp :: [Field]tp ep :: [Field]ep(:) :: a -> [a] -> [a]:fs' :: [Field]fs')
ifelse (Section n "if"   cond thenpart:fs)
       | null :: [a] -> Boolnull cond :: Stringcond     = syntaxError :: LineNo -> String -> ParseResult asyntaxError n :: LineNon "'if' with missing condition"
       | null :: [a] -> Boolnull thenpart :: [Field]thenpart = syntaxError :: LineNo -> String -> ParseResult asyntaxError n :: LineNon "'then' branch of 'if' is empty"
       | otherwise :: Boolotherwise     = do tp  <- ifelse :: [Field] -> ParseResult [Field]ifelse thenpart :: [Field]thenpart
                            fs' <- ifelse :: [Field] -> ParseResult [Field]ifelse fs :: [Field]fs
                            return :: Monad m => forall a. a -> m areturn (IfBlock :: LineNo -> String -> [Field] -> [Field] -> FieldIfBlock n :: LineNon cond :: Stringcond tp :: [Field]tp [] :: [a][](:) :: a -> [a] -> [a]:fs' :: [Field]fs')
ifelse (Section n "else" _ _:_) = syntaxError :: LineNo -> String -> ParseResult asyntaxError n :: LineNon "stray 'else' with no preceding 'if'"
ifelse (Section n s a fs':fs) = do fs''  <- ifelse :: [Field] -> ParseResult [Field]ifelse fs' :: [Field]fs'
                                   fs''' <- ifelse :: [Field] -> ParseResult [Field]ifelse fs :: [Field]fs
                                   return :: Monad m => forall a. a -> m areturn (Section :: LineNo -> String -> String -> [Field] -> FieldSection n :: LineNon s :: Strings a :: Fielda fs'' :: [Field]fs'' (:) :: a -> [a] -> [a]: fs''' :: [Field]fs''')
ifelse (f:fs) = do fs' <- ifelse :: [Field] -> ParseResult [Field]ifelse fs :: [Field]fs
                   return :: Monad m => forall a. a -> m areturn (f :: a -> ParseResult bf (:) :: a -> [a] -> [a]: fs' :: [Field]fs')

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

-- |parse a module name
parseModuleNameQ :: ReadP r ModuleName
parseModuleNameQ = parseQuoted :: ReadP r a -> ReadP r aparseQuoted parse :: Text a => forall r. ReadP r aparse (<++) :: ReadP a a -> ReadP r a -> ReadP r a<++ parse :: Text a => forall r. ReadP r aparse

parseFilePathQ :: ReadP r FilePath
parseFilePathQ = parseTokenQ :: ReadP r StringparseTokenQ
  -- removed until normalise is no longer broken, was:
  --   liftM normalise parseTokenQ

parseBuildTool :: ReadP r Dependency
parseBuildTool = do name <- parseBuildToolNameQ :: ReadP r PackageNameparseBuildToolNameQ
                    skipSpaces :: ReadP r ()skipSpaces
                    ver <- parseVersionRangeQ :: ReadP r VersionRangeparseVersionRangeQ (<++) :: ReadP a a -> ReadP r a -> ReadP r a<++ return :: Monad m => forall a. a -> m areturn anyVersion :: VersionRangeanyVersion
                    skipSpaces :: ReadP r ()skipSpaces
                    return :: Monad m => forall a. a -> m areturn ($) :: (a -> b) -> a -> b$ Dependency :: PackageName -> VersionRange -> DependencyDependency name :: Stringname ver :: VersionRangever

parseBuildToolNameQ :: ReadP r PackageName
parseBuildToolNameQ = parseQuoted :: ReadP r a -> ReadP r aparseQuoted parseBuildToolName :: ReadP r PackageNameparseBuildToolName (<++) :: ReadP a a -> ReadP r a -> ReadP r a<++ parseBuildToolName :: ReadP r PackageNameparseBuildToolName

-- like parsePackageName but accepts symbols in components
parseBuildToolName :: ReadP r PackageName
parseBuildToolName = do ns <- sepBy1 :: ReadP r a -> ReadP r sep -> ReadP r [a]sepBy1 component :: Parser r Char Stringcomponent (char :: Char -> ReadP r CharReadP.char '-')
                        return :: Monad m => forall a. a -> m areturn (PackageName :: String -> PackageNamePackageName (intercalate :: [a] -> [[a]] -> [a]intercalate "-" ns :: [String]ns))
  where component = do
          cs <- munch1 :: (Char -> Bool) -> ReadP r Stringmunch1 (\c -> isAlphaNum :: Char -> BoolisAlphaNum c :: Charc (||) :: Bool -> Bool -> Bool|| c :: Charc (==) :: Eq a => a -> a -> Bool== '+' (||) :: Bool -> Bool -> Bool|| c :: Charc (==) :: Eq a => a -> a -> Bool== '_')
          if all :: (a -> Bool) -> [a] -> Boolall isDigit :: Char -> BoolisDigit cs :: [Token]cs then pfail :: ReadP r apfail else return :: Monad m => forall a. a -> m areturn cs :: [Token]cs

-- pkg-config allows versions and other letters in package names,
-- eg "gtk+-2.0" is a valid pkg-config package _name_.
-- It then has a package version number like 2.10.13
parsePkgconfigDependency :: ReadP r Dependency
parsePkgconfigDependency = do name <- munch1 :: (Char -> Bool) -> ReadP r Stringmunch1 (\c -> isAlphaNum :: Char -> BoolisAlphaNum c :: Charc (||) :: Bool -> Bool -> Bool|| c :: Charc elem :: Eq a => a -> [a] -> Bool`elem` "+-._")
                              skipSpaces :: ReadP r ()skipSpaces
                              ver <- parseVersionRangeQ :: ReadP r VersionRangeparseVersionRangeQ (<++) :: ReadP a a -> ReadP r a -> ReadP r a<++ return :: Monad m => forall a. a -> m areturn anyVersion :: VersionRangeanyVersion
                              skipSpaces :: ReadP r ()skipSpaces
                              return :: Monad m => forall a. a -> m areturn ($) :: (a -> b) -> a -> b$ Dependency :: PackageName -> VersionRange -> DependencyDependency (PackageName :: String -> PackageNamePackageName name :: Stringname) ver :: VersionRangever

parsePackageNameQ :: ReadP r PackageName
parsePackageNameQ = parseQuoted :: ReadP r a -> ReadP r aparseQuoted parse :: Text a => forall r. ReadP r aparse (<++) :: ReadP a a -> ReadP r a -> ReadP r a<++ parse :: Text a => forall r. ReadP r aparse

parseVersionRangeQ :: ReadP r VersionRange
parseVersionRangeQ = parseQuoted :: ReadP r a -> ReadP r aparseQuoted parse :: Text a => forall r. ReadP r aparse (<++) :: ReadP a a -> ReadP r a -> ReadP r a<++ parse :: Text a => forall r. ReadP r aparse

parseOptVersion :: ReadP r Version
parseOptVersion = parseQuoted :: ReadP r a -> ReadP r aparseQuoted ver :: VersionRangever (<++) :: ReadP a a -> ReadP r a -> ReadP r a<++ ver :: VersionRangever
  where ver :: ReadP r Version
        ver = parse :: Text a => forall r. ReadP r aparse (<++) :: ReadP a a -> ReadP r a -> ReadP r a<++ return :: Monad m => forall a. a -> m areturn noVersion :: VersionnoVersion
        noVersion = Version{ versionBranch=[] :: [a][], versionTags=[] :: [a][] }

parseTestedWithQ :: ReadP r (CompilerFlavor,VersionRange)
parseTestedWithQ = parseQuoted :: ReadP r a -> ReadP r aparseQuoted tw :: ReadP r (CompilerFlavor, VersionRange)tw (<++) :: ReadP a a -> ReadP r a -> ReadP r a<++ tw :: ReadP r (CompilerFlavor, VersionRange)tw
  where
    tw :: ReadP r (CompilerFlavor,VersionRange)
    tw = do compiler <- parseCompilerFlavorCompat :: ReadP r CompilerFlavorparseCompilerFlavorCompat
            skipSpaces :: ReadP r ()skipSpaces
            version <- parse :: Text a => forall r. ReadP r aparse (<++) :: ReadP a a -> ReadP r a -> ReadP r a<++ return :: Monad m => forall a. a -> m areturn anyVersion :: VersionRangeanyVersion
            skipSpaces :: ReadP r ()skipSpaces
            return :: Monad m => forall a. a -> m areturn (compiler :: CompilerFlavorcompiler,version :: VersionRangeversion)

parseLicenseQ :: ReadP r License
parseLicenseQ = parseQuoted :: ReadP r a -> ReadP r aparseQuoted parse :: Text a => forall r. ReadP r aparse (<++) :: ReadP a a -> ReadP r a -> ReadP r a<++ parse :: Text a => forall r. ReadP r aparse

-- urgh, we can't define optQuotes :: ReadP r a -> ReadP r a
-- because the "compat" version of ReadP isn't quite powerful enough.  In
-- particular, the type of <++ is ReadP r r -> ReadP r a -> ReadP r a
-- Hence the trick above to make 'lic' polymorphic.

parseLanguageQ :: ReadP r Language
parseLanguageQ = parseQuoted :: ReadP r a -> ReadP r aparseQuoted parse :: Text a => forall r. ReadP r aparse (<++) :: ReadP a a -> ReadP r a -> ReadP r a<++ parse :: Text a => forall r. ReadP r aparse

parseExtensionQ :: ReadP r Extension
parseExtensionQ = parseQuoted :: ReadP r a -> ReadP r aparseQuoted parse :: Text a => forall r. ReadP r aparse (<++) :: ReadP a a -> ReadP r a -> ReadP r a<++ parse :: Text a => forall r. ReadP r aparse

parseHaskellString :: ReadP r String
parseHaskellString = readS_to_P :: ReadS a -> ReadP r areadS_to_P reads :: Read a => ReadS areads

parseTokenQ :: ReadP r String
parseTokenQ = parseHaskellString :: ReadP r StringparseHaskellString (<++) :: ReadP a a -> ReadP r a -> ReadP r a<++ munch1 :: (Char -> Bool) -> ReadP r Stringmunch1 (\x -> not :: Bool -> Boolnot (isSpace :: Char -> BoolisSpace x :: ax) (&&) :: Bool -> Bool -> Bool&& x :: ax (/=) :: Eq a => a -> a -> Bool/= ',')

parseTokenQ' :: ReadP r String
parseTokenQ' = parseHaskellString :: ReadP r StringparseHaskellString (<++) :: ReadP a a -> ReadP r a -> ReadP r a<++ munch1 :: (Char -> Bool) -> ReadP r Stringmunch1 (\x -> not :: Bool -> Boolnot (isSpace :: Char -> BoolisSpace x :: ax))

parseSepList :: ReadP r b
             -> ReadP r a -- ^The parser for the stuff between commas
             -> ReadP r [a]
parseSepList sepr p = sepBy :: ReadP r a -> ReadP r sep -> ReadP r [a]sepBy p :: ParseResult ap separator :: Parser r Char ()separator
    where separator = skipSpaces :: ReadP r ()skipSpaces (>>) :: Monad m => forall a b. m a -> m b -> m b>> sepr :: ReadP r bsepr (>>) :: Monad m => forall a b. m a -> m b -> m b>> skipSpaces :: ReadP r ()skipSpaces

parseSpaceList :: ReadP r a -- ^The parser for the stuff between commas
               -> ReadP r [a]
parseSpaceList p = sepBy :: ReadP r a -> ReadP r sep -> ReadP r [a]sepBy p :: ParseResult ap skipSpaces :: ReadP r ()skipSpaces

parseCommaList :: ReadP r a -- ^The parser for the stuff between commas
               -> ReadP r [a]
parseCommaList = parseSepList :: ReadP r b -> ReadP r a -> ReadP r [a]parseSepList (char :: Char -> ReadP r CharReadP.char ',')

parseOptCommaList :: ReadP r a -- ^The parser for the stuff between commas
                  -> ReadP r [a]
parseOptCommaList = parseSepList :: ReadP r b -> ReadP r a -> ReadP r [a]parseSepList (optional :: ReadP r a -> ReadP r ()optional (char :: Char -> ReadP r CharReadP.char ','))

parseQuoted :: ReadP r a -> ReadP r a
parseQuoted p = between :: ReadP r open -> ReadP r close -> ReadP r a -> ReadP r abetween (char :: Char -> ReadP r CharReadP.char '"') (char :: Char -> ReadP r CharReadP.char '"') p :: ParseResult ap

parseFreeText :: ReadP.ReadP s String
parseFreeText = munch :: (Char -> Bool) -> ReadP r StringReadP.munch (const :: a -> b -> aconst True :: BoolTrue)

-- --------------------------------------------
-- ** Pretty printing

showFilePath :: FilePath -> Doc
showFilePath = showToken :: String -> DocshowToken

showToken :: String -> Doc
showToken str
 | not :: Bool -> Boolnot (any :: (a -> Bool) -> [a] -> Boolany dodgy :: Char -> Booldodgy str :: Stringstr) (&&) :: Bool -> Bool -> Bool&&
   not :: Bool -> Boolnot (null :: [a] -> Boolnull str :: Stringstr)       = text :: String -> Doctext str :: Stringstr
 | otherwise :: Boolotherwise            = text :: String -> Doctext (show :: Show a => a -> Stringshow str :: Stringstr)
  where dodgy c = isSpace :: Char -> BoolisSpace c :: Charc (||) :: Bool -> Bool -> Bool|| c :: Charc (==) :: Eq a => a -> a -> Bool== ','

showTestedWith :: (CompilerFlavor,VersionRange) -> Doc
showTestedWith (compiler, version) = text :: String -> Doctext (show :: Show a => a -> Stringshow compiler :: CompilerFlavorcompiler) (<+>) :: Doc -> Doc -> Doc<+> disp :: Text a => a -> Docdisp version :: VersionRangeversion

-- | Pretty-print free-format text, ensuring that it is vertically aligned,
-- and with blank lines replaced by dots for correct re-parsing.
showFreeText :: String -> Doc
showFreeText "" = empty :: Docempty
showFreeText ('\n' :r)  = text :: String -> Doctext " " ($+$) :: Doc -> Doc -> Doc$+$ text :: String -> Doctext "." ($+$) :: Doc -> Doc -> Doc$+$ showFreeText :: String -> DocshowFreeText r :: [Char]r
showFreeText s  = vcat :: [Doc] -> Docvcat [text :: String -> Doctext (if null :: [a] -> Boolnull l :: [(a, [[a]])]l then "." else l :: [(a, [[a]])]l) | l <- lines_ :: String -> [String]lines_ s :: Strings]

-- | 'lines_' breaks a string up into a list of strings at newline
-- characters.  The resulting strings do not contain newlines.
lines_                   :: String -> [String]
lines_ []                =  [""]
lines_ s                 =  let (l, s') = break :: (a -> Bool) -> [a] -> ([a], [a])break ((==) :: Eq a => a -> a -> Bool== '\n') s :: Strings
                            in  l :: [(a, [[a]])]l (:) :: a -> [a] -> [a]: case s' :: [Char]s' of
                                        []    -> [] :: [a][]
                                        (_:s'') -> lines_ :: String -> [String]lines_ s'' :: [Char]s''