aihc-cabal-syntax (empty) → 1.0.0.1

raw patch · 22 files changed

+4548/−0 lines, 22 filesdep +Cabal-syntaxdep +aesondep +aihc-cabal-syntax

Dependencies added: Cabal-syntax, aeson, aihc-cabal-syntax, base, bytestring, containers, directory, filepath, hedgehog, megaparsec, parser-combinators, tar, text

Files

• CHANGELOG.md +17/−0
• LICENSE +24/−0
• README.md +62/−0
• aihc-cabal-syntax.cabal +57/−0
• src/Aihc/Cabal.hs +112/−0
• src/Aihc/Cabal/Internal/Condition.hs +127/−0
• src/Aihc/Cabal/Internal/Lexer.hs +300/−0
• src/Aihc/Cabal/Internal/Parser.hs +551/−0
• src/Aihc/Cabal/Internal/Quirks.hs +224/−0
• src/Aihc/Cabal/Internal/Resolve.hs +64/−0
• src/Aihc/Cabal/Internal/Types.hs +402/−0
• src/Aihc/Cabal/Internal/Values.hs +298/−0
• src/Aihc/Cabal/Internal/Version.hs +234/−0
• test/Compliance/Adapter.hs +259/−0
• test/Compliance/Compare.hs +63/−0
• test/Compliance/Tests.hs +182/−0
• test/Hackage.hs +114/−0
• test/Main.hs +486/−0
• test/RoundTrip.hs +767/−0
• test/fixtures/aihc-hackage.cabal +67/−0
• test/fixtures/aihc-haddock.cabal +78/−0
• test/fixtures/aihc-package-plan.cabal +60/−0

@@ -0,0 +1,17 @@+# Changelog++All notable changes to this project are recorded in this file.++This project uses the format from [Keep a Changelog](https://keepachangelog.com/en/1.1.0/).++## [1.0.0.1] - 2026-09-29++### Changed++- Add dependency bounds and package metadata.++## [1.0.0.0] - 2026-09-29++### Added++- Add a Cabal parser that is 100% compatible with Cabal-syntax.

@@ -0,0 +1,24 @@+This is free and unencumbered software released into the public domain.++Anyone is free to copy, modify, publish, use, compile, sell, or+distribute this software, either in source code form or as a compiled+binary, for any purpose, commercial or non-commercial, and by any+means.++In jurisdictions that recognize copyright laws, the author or authors+of this software dedicate any and all copyright interest in the+software to the public domain. We make this dedication for the benefit+of the public at large and to the detriment of our heirs and+successors. We intend this dedication to be an overt act of+relinquishment in perpetuity of all present and future rights to this+software under copyright law.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.+IN NO EVENT SHALL THE AUTHORS BE LIABLE FOR ANY CLAIM, DAMAGES OR+OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE,+ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR+OTHER DEALINGS IN THE SOFTWARE.++For more information, please refer to <https://unlicense.org>

@@ -0,0 +1,62 @@+<!-- Generated by scripts/readme.py. Do not edit. -->+# aihc-cabal-syntax++A small Haskell library that parses `.cabal` files for the aihc compiler.+It provides package data, version ranges, and condition evaluation without a runtime dependency on Cabal or Cabal-syntax.+It uses Megaparsec. It does not solve dependencies or build packages.++## Hackage results++The fixed Hackage index contains **200,642 file revisions**.+The reference parser is **Cabal-syntax 3.18.1.0**.++| Result | Files | All files |+| --- | ---: | ---: |+| aihc-cabal-syntax accepts | 200,642 | 100.00% |+| Cabal-syntax accepts | 200,642 | 100.00% |+| Equal converted data | 200,642 | 100.00% |++An accepted file does not prove full compliance.+The equality test compares complete `GenericPackageDescription` values after conversion of our AST.+Conversion limits can also cause differences. This library is not a complete replacement for Cabal-syntax.++## Stackage LTS results++The Stackage test uses **Stackage LTS 24.38** with **3,370 packages**.+The pinned Nixpkgs revision supplies the package list.+The test uses the last revision of each package version in the fixed Hackage index.++| Result | Packages | All packages |+| --- | ---: | ---: |+| aihc-cabal-syntax accepts | 3,370 | 100.00% |+| Cabal-syntax accepts | 3,370 | 100.00% |+| Equal converted data | 3,370 | 100.00% |++The Nix check fails if a package in the snapshot does not have equal converted data.++## Parse benchmark++Each parser reads all **200,642 revisions** in a separate process on the same machine.++| Measurement | aihc-cabal-syntax | Cabal-syntax | aihc / Cabal-syntax |+| --- | ---: | ---: | ---: |+| Elapsed time | 47.64 s | 132.77 s | 0.36× |+| Peak process memory (RSS) | 23.20 MiB | 37.56 MiB | 0.62× |++A ratio below 1 means less time or memory than Cabal-syntax.+Measured on `aarch64-darwin` with GHC 9.10.3, `-O2`, and one RTS capability.+Time includes archive input, parsing, and result evaluation through `show`.+The benchmark includes rejected files. It discards each result before the next file.+Each parser has one measured run. Machine load and file caching affect the time.+The parsers produce different data and accept different numbers of files; these ratios include that difference.++## Build and update++```sh+nix build --no-update-lock-file+nix flake check --no-update-lock-file+nix run .#update-readme --no-update-lock-file+```++The update command runs the full comparison and a new benchmark, then writes this README and the measurement data.+Nix pins the tools and test data. See [test details](docs/hackage.md) and [API use and limits](docs/api.md).

@@ -0,0 +1,57 @@+cabal-version: 3.0+name: aihc-cabal-syntax+version: 1.0.0.1+synopsis: Parse Cabal files for aihc+description: Parse Cabal package files for the aihc compiler.+  Read package data, version ranges, and condition expressions.+category: Parsing+maintainer: David Himmelstrup <lemmih@gmail.com>+license: Unlicense+license-file: LICENSE+build-type: Simple+extra-doc-files: CHANGELOG.md+extra-source-files: README.md test/fixtures/*.cabal++library+  exposed-modules: Aihc.Cabal+  other-modules:+    Aihc.Cabal.Internal.Condition+    Aihc.Cabal.Internal.Lexer+    Aihc.Cabal.Internal.Parser+    Aihc.Cabal.Internal.Quirks+    Aihc.Cabal.Internal.Resolve+    Aihc.Cabal.Internal.Types+    Aihc.Cabal.Internal.Values+    Aihc.Cabal.Internal.Version+  hs-source-dirs: src+  build-depends: base >=4.16 && <5, bytestring <0.13, containers <0.9, text <2.2, megaparsec >=9 && <10, parser-combinators <1.4+  default-language: Haskell2010+  ghc-options: -Wall++test-suite parser-tests+  type: exitcode-stdio-1.0+  main-is: Main.hs+  hs-source-dirs: test+  build-depends: base, aihc-cabal-syntax, bytestring <0.13, containers <0.9, text <2.2, Cabal-syntax >=3.18.1 && <3.19+  default-language: Haskell2010+  ghc-options: -Wall++test-suite hackage-compliance+  type: exitcode-stdio-1.0+  main-is: Hackage.hs+  hs-source-dirs: test+  other-modules: Compliance.Adapter Compliance.Compare Compliance.Tests+  build-depends: base, aihc-cabal-syntax, bytestring <0.13, containers <0.9, text <2.2,+    Cabal-syntax >=3.18.1 && <3.19, aeson <2.3, tar <0.7, directory <1.4, filepath <1.6+  default-language: Haskell2010+  ghc-options: -Wall -rtsopts++test-suite pretty-roundtrip+  type: exitcode-stdio-1.0+  main-is: RoundTrip.hs+  hs-source-dirs: test+  other-modules: Compliance.Adapter+  build-depends: base, aihc-cabal-syntax, bytestring <0.13, containers <0.9, text <2.2,+    Cabal-syntax >=3.18.1 && <3.19, hedgehog >=1.5 && <1.6+  default-language: Haskell2010+  ghc-options: -Wall

@@ -0,0 +1,112 @@+-- | Parse Cabal package descriptions for the aihc compiler.+--+-- This is the only public module of the package. It has no dependency on+-- Cabal or Cabal-syntax. The parser follows the package parser of+-- Cabal-syntax 3.18.1.0 and accepts format versions 1.0 through 3.18.+--+-- The record field names are short, for example 'buildable' and+-- 'dependencies'. Import the module qualified to keep them out of your+-- namespace.+--+-- = Use+--+-- Read a package, evaluate its conditions for one target, and read the+-- fields of the main library:+--+-- @+-- import qualified Aihc.Cabal as Cabal+-- import qualified Data.ByteString as BS+-- import qualified Data.Map.Strict as Map+--+-- main :: IO ()+-- main = do+--   bytes <- BS.readFile \"text.cabal\"+--   package <- either (fail . show) pure (Cabal.parseValue (Cabal.parsePackage bytes))+--   ghc <- either (fail . show) pure (Cabal.parseVersion \"9.12.2\")+--   let environment = Cabal.Environment \"linux\" \"x86_64\" \"ghc\" ghc+--       overrides = Map.fromList [(\"simdutf\", False)]+--       resolved = Cabal.resolvePackage environment overrides package+--   case [bi | Cabal.Component (Cabal.Library Cabal.MainLibrary) bi <- Cabal.resolvedComponents resolved] of+--     [library] -> do+--       print (Cabal.exposedModules library)+--       print (map Cabal.dependencyPackage (Cabal.dependencies library))+--       print (map Cabal.fieldText (Map.findWithDefault [] \"x-aihc-lir-sources\" (Cabal.extraFields library)))+--     _ -> fail \"No main library\"+-- @+--+-- 'parsePackage' keeps conditions. 'resolvePackage' evaluates them for an+-- t'Environment' and a 'FlagAssignment', merges the active parts, and applies+-- defaults. The caller selects the components to build. A dependency solver+-- can inspect the t'Conditional' values of a t'Package' before it selects+-- flags.+--+-- = Limits+--+-- * Package fields other than @name@, @version@, @cabal-version@, and+--   @build-type@ stay in 'packageFields' as text. Component fields without+--   a t'BuildInfo' field stay in 'extraFields' as text. The parser does not+--   check these values.+-- * The parser stops at the first error.+-- * There is no version range simplifier and no package printer.+-- * The library does not solve dependencies, find source files, or run+--   configure scripts.+module Aihc.Cabal+  ( -- * Parsing+    parsePackage+  , parseHookedBuildInfo+  , ParseResult (..)+  , Diagnostic (..)+  , Position (..)+    -- * Packages+  , Package (..)+  , packageFieldText+  , Flag (..)+  , SourceRepository (..)+  , FieldValue (..)+  , FieldLine (..)+  , fieldText+    -- * Components+  , Component (..)+  , ComponentKind (..)+  , LibraryTarget (..)+  , Conditional (..)+  , Branch (..)+  , Condition (..)+    -- * Build information+  , BuildInfo (..)+  , emptyBuildInfo+  , mergeBuildInfo+  , Dependency (..)+  , ToolDependency (..)+  , Mixin (..)+  , ModuleRenaming (..)+  , HookedBuildInfo (..)+    -- * Resolution+  , Environment (..)+  , FlagAssignment+  , evaluateCondition+  , resolvePackage+  , ResolvedPackage (..)+    -- * Versions+  , Version+  , mkVersion+  , versionNumbers+  , parseVersion+  , renderVersion+    -- * Version ranges+  , VersionRange (..)+  , anyVersion+  , noVersion+  , thisVersion+  , withinVersion+  , intersectRanges+  , unionRanges+  , withinRange+  , parseVersionRange+  , renderVersionRange+  ) where++import Aihc.Cabal.Internal.Parser+import Aihc.Cabal.Internal.Resolve+import Aihc.Cabal.Internal.Types+import Aihc.Cabal.Internal.Version

@@ -0,0 +1,127 @@+{-# LANGUAGE OverloadedStrings #-}+-- | Parse a condition from the arguments of an @if@ or @elif@ section.+-- This module follows the condition parser of Cabal-syntax 3.12. The parser+-- reads section argument tokens, not text.+module Aihc.Cabal.Internal.Condition (parseCondition) where++import Control.Applicative (Alternative (..))+import Control.Monad (ap)+import Data.Char (isDigit, isAlphaNum)+import qualified Data.List.NonEmpty as NE+import Data.Text (Text)+import qualified Data.Text as T+import Text.Megaparsec (eof, runParser, satisfy, takeWhile1P)+import qualified Text.Megaparsec as M+import Text.Megaparsec.Char (char)+import Aihc.Cabal.Internal.Lexer (SectionArg (..))+import Aihc.Cabal.Internal.Types (Condition (..))+import Aihc.Cabal.Internal.Values (flagNameValue, identifier)+import Aihc.Cabal.Internal.Version++-- | A parser with Parsec semantics: an alternative runs only when the first+-- parser fails without input consumption.+newtype P a = P { runP :: [SectionArg] -> Reply a }++data Reply a = Ok a [SectionArg] Bool | Err Bool++instance Functor P where+  fmap f (P p) = P $ \s -> case p s of+    Ok a r c -> Ok (f a) r c+    Err c -> Err c++instance Applicative P where+  pure x = P (\s -> Ok x s False)+  (<*>) = ap++instance Monad P where+  P p >>= k = P $ \s -> case p s of+    Err c -> Err c+    Ok a r c -> case runP (k a) r of+      Ok b r' c' -> Ok b r' (c || c')+      Err c' -> Err (c || c')++instance Alternative P where+  empty = P (const (Err False))+  P p <|> P q = P $ \s -> case p s of+    Err False -> q s+    reply -> reply+  many p = some p <|> pure []+  some p = (:) <$> p <*> many p++instance MonadFail P where+  fail _ = empty++try :: P a -> P a+try (P p) = P $ \s -> case p s of+  Err _ -> Err False+  reply -> reply++tokenWith :: (SectionArg -> Maybe a) -> P a+tokenWith f = P $ \s -> case s of+  x : rest | Just a <- f x -> Ok a rest True+  _ -> Err False++name :: P Text+name = tokenWith $ \t -> case t of+  ArgName _ x -> Just x+  _ -> Nothing++word :: Text -> P ()+word w = tokenWith $ \t -> case t of+  ArgName _ x | x == w -> Just ()+  _ -> Nothing++oper :: Text -> P ()+oper o = tokenWith $ \t -> case t of+  ArgOther _ x | x == o -> Just ()+  _ -> Nothing++-- | Consume a name token and parse it completely. A parse error after the+-- token is an error with input consumption.+value :: Parser a -> P a+value p = do+  x <- name+  case runParser (p <* eof) "" x of+    Left _ -> P (const (Err True))+    Right a -> pure a++parens :: P a -> P a+parens p = oper "(" *> p <* oper ")"++sepBy1 :: P a -> P s -> P (NE.NonEmpty a)+sepBy1 p s = (NE.:|) <$> p <*> many (s *> p)++parseCondition :: [SectionArg] -> Maybe Condition+parseCondition args = case runP (condOr <* end) args of+  Ok c _ _ -> Just c+  Err _ -> Nothing+  where+    end = P $ \s -> if null s then Ok () s False else Err False+    condOr = foldl1 Or <$> sepBy1 condAnd (oper "||")+    condAnd = foldl1 And <$> sepBy1 cond (oper "&&")+    cond = boolean <|> parens condOr <|> (Not <$> (oper "!" *> cond))+      <|> (word "os" *> parens (OS <$> value identifier))+      <|> (word "arch" *> parens (Arch <$> value identifier))+      <|> (word "flag" *> parens (FlagValue <$> value flagNameValue))+      <|> (word "impl" *> parens (Impl <$> value compiler <*> (versionRange <|> pure anyVersion)))+    boolean = tokenWith $ \t -> case t of+      ArgName _ x+        | x `elem` ["True", "true"] -> Just (Literal True)+        | x `elem` ["False", "false"] -> Just (Literal False)+      _ -> Nothing+    compiler = do+      x <- takeWhile1P Nothing isAlphaNum+      if T.all isDigit x then fail "all digits compiler name" else pure x+    versionRange = expr+      where+        expr = foldl1 EitherRange <$> sepBy1 term (oper "||")+        term = foldl1 Both <$> sepBy1 factor (oper "&&")+        factor = parens expr+          <|> (AnyVersion <$ word "-any")+          <|> (noVersion <$ word "-none")+          <|> try (withinVersion <$> (oper "==" *> value versionStar) <* oper "*")+          <|> foldr1 (<|>) [try (f <$> (oper o *> value versionParser)) | (o, f) <- operators]+        operators =+          [ ("<", Earlier), ("<=", AtMost), (">", Later), (">=", AtLeast)+          , ("^>=", MajorBound), ("==", Equal) ]+        versionStar = specVersion <$> M.some (read <$> M.some (satisfy isDigit) <* char '.')

@@ -0,0 +1,300 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE OverloadedStrings #-}+-- | Read the outline of a Cabal file: fields, sections, and their positions.+-- This module follows the lexer and the outline parser of Cabal-syntax 3.12.+module Aihc.Cabal.Internal.Lexer+  ( Field (..), SectionArg (..), readFields, sectionArgText+  ) where++import Data.Char (isAsciiUpper, ord, toLower)+import Data.Maybe (fromMaybe)+import Data.Text (Text)+import qualified Data.Text as T+import Aihc.Cabal.Internal.Types (Diagnostic (..), FieldLine (..), Position (..))++data Field+  = Field !Position Text [FieldLine]+  | Section !Position Text [SectionArg] [Field]+  deriving Show++data SectionArg+  = ArgName !Position Text+  | ArgString !Position Text+  | ArgOther !Position Text+  deriving Show++sectionArgText :: SectionArg -> Text+sectionArgText (ArgName _ t) = t+sectionArgText (ArgString _ t) = t+sectionArgText (ArgOther _ t) = t++data Token+  = TokSym Text | TokStr Text | TokOther Text | Indent Int | TokFieldLine Text+  | Colon | OpenBrace | CloseBrace | EOF | LexicalError+  deriving (Eq, Show)++data Mode = BolSection | InSection | BolFieldLayout | InFieldLayout | BolFieldBraces | InFieldBraces+  deriving (Eq, Show)++-- | The state before a token. The token and the next state are computed+-- on demand, as in the Cabal-syntax parser.+data LexState = LexState+  { lexRow :: !Int+  , lexColumn :: !Int+  , lexInput :: !Text+  , lexMode :: !Mode+  }++data Stream = Stream LexState (Position, Token, Stream)++stream :: LexState -> Stream+stream st = Stream st (lexToken st)++setMode :: Mode -> Stream -> Stream+setMode m (Stream st _) = stream st {lexMode = m}++peek :: Stream -> (Position, Token)+peek (Stream _ (p, t, _)) = (p, t)++advance :: Stream -> Stream+advance (Stream _ (_, _, next)) = next++-- | The number of bytes in the UTF-8 encoding. Cabal-syntax counts columns in bytes.+width :: Char -> Int+width c+  | n < 0x80 = 1+  | n < 0x800 = 2+  | n < 0x10000 = 3+  | otherwise = 4+  where n = ord c++widthOf :: Text -> Int+widthOf = T.foldl' (\a c -> a + width c) 0++isSpaceTab :: Char -> Bool+isSpaceTab c = c == ' ' || c == '\t'++-- | Characters in the Cabal lexer class @$printable@.+isPrintable :: Char -> Bool+isPrintable c = c > '\x1f' && c /= '\x7f'++isSymbol' :: Char -> Bool+isSymbol' c = c `elem` (",=<>+*&|!$%^@#?/\\~" :: String)++isNameChar :: Char -> Bool+isNameChar c = isPrintable c && not (c `elem` (" :\"{}()[]" :: String)) && not (isSymbol' c)++isOpChar :: Char -> Bool+isOpChar c = isSymbol' c || c == '-' || c == '.'++isParen :: Char -> Bool+isParen c = c `elem` ("()[]" :: String)++-- | Split a line break at the start of the text: @\\n@, @\\r\\n@, or @\\r@.+newline :: Text -> Maybe Text+newline t = case T.uncons t of+  Just ('\n', rest) -> Just rest+  Just ('\r', rest) -> Just (fromMaybe rest (T.stripPrefix "\n" rest))+  _ -> Nothing++lexToken :: LexState -> (Position, Token, Stream)+lexToken st@(LexState row col input mode) = case mode of+  BolSection -> bol st $ \ws rest -> case T.uncons rest of+    Just ('{', r) | T.all isSpaceTab ws -> token col OpenBrace (LexState row (col + T.length ws + 1) r BolSection)+    Just ('}', r) | T.all isSpaceTab ws -> token col CloseBrace (LexState row (col + T.length ws + 1) r BolSection)+    _ -> indentation ws rest InSection+  BolFieldLayout -> bol st $ \ws rest -> indentation ws rest InFieldLayout+  BolFieldBraces -> bol st $ \_ _ -> lexToken st {lexMode = InFieldBraces}+  InSection -> case T.uncons input of+    Nothing -> token col EOF st+    Just (c, rest)+      | isSpaceTab c -> let (ws, r) = T.span isSpaceTab input in lexToken st {lexColumn = col + T.length ws, lexInput = r}+      | "--" `T.isPrefixOf` input ->+          let (comment, r) = T.span isCommentChar input+          in lexToken st {lexColumn = col + widthOf comment, lexInput = r}+      | Just r <- newline input -> lexToken (LexState (row + 1) 1 r BolSection)+      | c == ':' -> token col Colon st {lexColumn = col + 1, lexInput = rest}+      | c == '{' -> token col OpenBrace st {lexColumn = col + 1, lexInput = rest}+      | c == '}' -> token col CloseBrace st {lexColumn = col + 1, lexInput = rest}+      | c == '"' -> case stringToken rest of+          Just (s, r) -> token col (TokStr s) st {lexColumn = col + widthOf s + 2, lexInput = r}+          Nothing -> token col LexicalError st {lexInput = ""}+      | isParen c -> token col (TokOther (T.singleton c)) st {lexColumn = col + 1, lexInput = rest}+      | otherwise ->+          -- The longest match wins. A name wins a tie with an operator.+          let nameLen = T.length (T.takeWhile isNameChar input)+              opLen = T.length (T.takeWhile isOpChar input)+          in if nameLen == 0 && opLen == 0 then token col LexicalError st {lexInput = ""}+             else if nameLen >= opLen then word TokSym nameLen+             else word TokOther opLen+  InFieldLayout -> fieldLine (const True)+  InFieldBraces -> case T.uncons input of+    Just ('{', rest) -> token col OpenBrace st {lexColumn = col + 1, lexInput = rest}+    Just ('}', rest) -> token col CloseBrace st {lexColumn = col + 1, lexInput = rest}+    _ -> fieldLine (\c -> c /= '{' && c /= '}')+  where+    token c t next = (Position row c, t, stream next)+    word constructor n =+      let (w, rest) = T.splitAt n input+      in token col (constructor w) st {lexColumn = col + widthOf w, lexInput = rest}+    isCommentChar c = isPrintable c || c == '\t'+    -- Skip blank lines and comment lines at the start of a line.+    bol s k =+      let (ws, rest) = T.span (\c -> isSpaceTab c || c == '\xa0') (lexInput s)+      in case newline rest of+        Just r -> lexToken s {lexRow = lexRow s + 1, lexColumn = 1, lexInput = r}+        Nothing+          | "--" `T.isPrefixOf` T.dropWhile isSpaceTab (lexInput s) ->+              let (sp, afterSp) = T.span isSpaceTab (lexInput s)+                  (comment, r) = T.span isCommentChar afterSp+              in lexToken s {lexColumn = lexColumn s + T.length sp + widthOf comment, lexInput = r}+          | otherwise -> k ws rest+    indentation ws rest next+      | T.null rest = (Position row col, EOF, stream st)+      | otherwise =+          let n = T.length ws+          in token col (Indent n) (LexState row (col + n) rest next)+    fieldLine allowed = case T.uncons input of+      Nothing -> token col EOF st+      Just (c, _)+        | isSpaceTab c -> let (ws, r) = T.span isSpaceTab input in lexToken st {lexColumn = col + T.length ws, lexInput = r}+        | Just r <- newline input ->+            lexToken (LexState (row + 1) 1 r (if mode == InFieldLayout then BolFieldLayout else BolFieldBraces))+        | isPrintable c && allowed c ->+            let (line, r) = T.span (\x -> (isPrintable x || x == '\t') && allowed x) input+            in token col (TokFieldLine line) st {lexColumn = col + widthOf line, lexInput = r}+        | otherwise -> token col LexicalError st {lexInput = ""}++-- | The contents of a string token without its quotes. Escapes stay in the text.+-- The lexer uses the longest match: a quotation mark after a backslash can end+-- the string or continue it.+stringToken :: Text -> Maybe (Text, Text)+stringToken t = (\n -> (T.take n t, T.drop (n + 1) t)) <$> go Nothing ' ' 0 (T.unpack t)+  where+    go :: Maybe Int -> Char -> Int -> String -> Maybe Int+    go end _ _ [] = end+    go end previous !n (c : cs)+      | c == '"' = if previous == '\\' then go (Just n) c (n + 1) cs else Just n+      | isPrintable c = go end c (n + 1) cs+      | otherwise = end++type Parse a = Stream -> Either Diagnostic (a, Stream)++parseError :: Position -> Token -> Either Diagnostic a+parseError p t = Left (Diagnostic (Just p) ("Unexpected " <> describe t))+  where+    describe x = case x of+      TokSym s -> "symbol " <> T.pack (show s)+      TokStr s -> "string " <> T.pack (show s)+      TokOther s -> "operator " <> T.pack (show s)+      Indent _ -> "new line"+      TokFieldLine _ -> "field content"+      Colon -> "\":\""+      OpenBrace -> "\"{\""+      CloseBrace -> "\"}\""+      EOF -> "end of file"+      LexicalError -> "character in input"++lowerName :: Text -> Text+lowerName = T.map (\c -> if isAsciiUpper c then toLower c else c)++-- | Read the fields and sections of a file. The input has no byte order mark.+readFields :: Text -> Either Diagnostic [Field]+readFields input = do+  (fields, s) <- elements 0 (stream (LexState 1 1 input BolSection))+  case peek s of+    (_, EOF) -> Right fields+    (p, t) -> parseError p t++elements :: Int -> Parse [Field]+elements level = go []+  where+    go acc s = case peek s of+      (_, Indent j) | j >= level -> do+        let s1 = advance s+        case peek s1 of+          (p, TokSym n) -> do+            (f, s2) <- layoutElement (j + 1) p (lowerName n) (advance s1)+            go (f : acc) s2+          (p, t) -> parseError p t+      (p, TokSym n) -> do+        (f, s1) <- bracesElement p (lowerName n) (advance s)+        go (f : acc) s1+      _ -> Right (reverse acc, s)++sectionArgs :: Stream -> ([SectionArg], Stream)+sectionArgs = go []+  where+    go acc s = case peek s of+      (p, TokSym x) -> go (ArgName p x : acc) (advance s)+      (p, TokStr x) -> go (ArgString p x : acc) (advance s)+      (p, TokOther x) -> go (ArgOther p x : acc) (advance s)+      _ -> (reverse acc, s)++layoutElement :: Int -> Position -> Text -> Parse Field+layoutElement level p n s = case peek s of+  (_, Colon) -> fieldLayoutOrBraces level p n (advance s)+  _ -> do+    let (args, s1) = sectionArgs s+    case peek s1 of+      (_, OpenBrace) -> do+        (fields, s2) <- bracesBody (advance s1)+        Right (Section p n args fields, s2)+      _ -> do+        (fields, s2) <- elements level s1+        Right (Section p n args fields, s2)++bracesElement :: Position -> Text -> Parse Field+bracesElement p n s = case peek s of+  (_, Colon) -> do+    let s1 = advance s+    case peek s1 of+      (_, OpenBrace) -> fieldBraces p n (advance s1)+      _ -> do+        let s2 = setMode InFieldBraces s1+        case peek s2 of+          (q, TokFieldLine l) -> Right (Field p n [FieldLine q l], setMode InSection (advance s2))+          _ -> Right (Field p n [], setMode InSection s2)+  _ -> do+    let (args, s1) = sectionArgs s+    case peek s1 of+      (_, OpenBrace) -> do+        (fields, s2) <- bracesBody (advance s1)+        Right (Section p n args fields, s2)+      (q, t) -> parseError q t++bracesBody :: Parse [Field]+bracesBody s = do+  (fields, s1) <- elements 0 s+  let s2 = case peek s1 of+        (_, Indent _) -> advance s1+        _ -> s1+  case peek s2 of+    (_, CloseBrace) -> Right (fields, advance s2)+    (q, t) -> parseError q t++fieldLayoutOrBraces :: Int -> Position -> Text -> Parse Field+fieldLayoutOrBraces level p n s = case peek s of+  (_, OpenBrace) -> fieldBraces p n (advance s)+  _ -> do+    let s1 = setMode InFieldLayout s+        (first, s2) = case peek s1 of+          (q, TokFieldLine l) -> ([FieldLine q l], advance s1)+          _ -> ([], s1)+        rest acc st = case peek st of+          (_, Indent j) | j >= level -> case peek (advance st) of+            (q, TokFieldLine l) -> rest (FieldLine q l : acc) (advance (advance st))+            (q, t) -> parseError q t+          _ -> Right (reverse acc, st)+    (more, s3) <- rest [] s2+    Right (Field p n (first ++ more), setMode InSection s3)++fieldBraces :: Position -> Text -> Parse Field+fieldBraces p n s = do+  let go acc st = case peek st of+        (q, TokFieldLine l) -> go (FieldLine q l : acc) (advance st)+        _ -> (reverse acc, setMode InSection st)+      (ls, s1) = go [] (setMode InFieldBraces s)+  case peek s1 of+    (_, CloseBrace) -> Right (Field p n ls, advance s1)+    (q, t) -> parseError q t

@@ -0,0 +1,551 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE OverloadedStrings #-}+-- | Read package descriptions. The rules follow the package parser of+-- Cabal-syntax 3.18. The parser accepts Cabal format versions up to 3.18.+module Aihc.Cabal.Internal.Parser (parsePackage, parseHookedBuildInfo) where++import Control.Monad (foldM, guard, unless, when)+import Data.Bits (shiftL, (.&.), (.|.))+import qualified Data.ByteString as BS+import qualified Data.ByteString.Char8 as BS8+import Data.Char (isAlphaNum)+import Data.List (find, partition)+import Data.List.NonEmpty (NonEmpty (..))+import qualified Data.List.NonEmpty as NE+import Data.Map.Strict (Map)+import qualified Data.Map.Strict as Map+import Data.Maybe (fromMaybe, isJust)+import Data.Text (Text)+import qualified Data.Text as T+import qualified Data.Text.Encoding as TE+import Text.Megaparsec (eof, runParser, takeWhile1P, (<|>))+import Text.Megaparsec.Char (space)+import Aihc.Cabal.Internal.Condition (parseCondition)+import Aihc.Cabal.Internal.Lexer (Field (..), SectionArg (..), readFields)+import Aihc.Cabal.Internal.Quirks (patchQuirks)+import Aihc.Cabal.Internal.Types+import Aihc.Cabal.Internal.Values+import Aihc.Cabal.Internal.Version++type Result a = Either Diagnostic a++type Fields = Map Text [FieldValue]++-- | A section inside a list of fields: position, name, arguments, and contents.+data SectionInfo = SectionInfo Position Text [SectionArg] [Field]++failAt :: Position -> Text -> Result a+failAt p = Left . Diagnostic (Just p)++-- | An error of a check on the complete package. It has no position.+failPackage :: Text -> Result a+failPackage = Left . Diagnostic Nothing++report :: Result a -> ParseResult a+report = ParseResult []++-- | Decode UTF-8 text. For invalid input, use the Cabal-syntax decoder: it+-- replaces each invalid sequence with U+FFFD and continues.+decode :: BS.ByteString -> Text+decode bytes = either (const (T.pack (lenient (BS.unpack bytes)))) id (TE.decodeUtf8' bytes)+  where+    lenient [] = []+    lenient (c : cs)+      | c <= 0x7f = toEnum (fromIntegral c) : lenient cs+      | c <= 0xbf = replacement : lenient cs+      | c <= 0xdf = case cs of+          c1 : rest | c1 .&. 0xc0 == 0x80 ->+            let d = (fromIntegral (c .&. 0x1f) `shiftL` 6) .|. fromIntegral (c1 .&. 0x3f)+            in (if d >= 0x80 then toEnum d else replacement) : lenient rest+          _ -> replacement : lenient cs+      | c <= 0xef = more (3 :: Int) 0x800 cs (fromIntegral (c .&. 0xf))+      | c <= 0xf7 = more 4 0x10000 cs (fromIntegral (c .&. 0x7))+      | c <= 0xfb = more 5 0x200000 cs (fromIntegral (c .&. 0x3))+      | c <= 0xfd = more 6 0x4000000 cs (fromIntegral (c .&. 0x1))+      | otherwise = replacement : lenient cs+    more 1 overlong cs acc+      | overlong <= acc && acc <= 0x10ffff && (acc < 0xd800 || 0xdfff < acc) = toEnum acc : lenient cs+      | otherwise = replacement : lenient cs+    more n overlong (c : cs) acc+      | c .&. 0xc0 == 0x80 = more (n - 1) overlong cs ((acc `shiftL` 6) .|. fromIntegral (c .&. 0x3f))+    more _ _ cs _ = replacement : lenient cs+    replacement = '\xfffd' ++readInput :: BS.ByteString -> Result [Field]+readInput bytes = readFields (fromMaybe text (T.stripPrefix "\xfeff" text))+  where text = decode bytes++parseField :: Parser a -> FieldValue -> Result a+parseField p fv = either (failAt (fieldPosition fv)) Right (runValue p (fieldText fv))++-- | A singular field. The last value wins. As in Cabal-syntax, the first of+-- several values is not parsed.+singular :: (FieldValue -> Result a) -> [FieldValue] -> Result (Maybe a)+singular _ [] = Right Nothing+singular f [x] = Just <$> f x+singular f (_ : xs) = Just . last <$> mapM f xs++-- | A singular field that has no value when its text is empty.+optionalField :: Parser a -> [FieldValue] -> Result (Maybe a)+optionalField p = fmap (>>= id) . singular one+  where one fv = if null (fieldLines fv) then Right Nothing else Just <$> parseField p fv++monoidal :: Parser [a] -> [FieldValue] -> Result [a]+monoidal p = fmap concat . mapM (parseField p)++takeFields :: [Field] -> (Fields, [Field])+takeFields fields = (collect [(n, FieldValue p ls) | Field p n ls <- leading], rest)+  where (leading, rest) = span isField fields++isField :: Field -> Bool+isField Field {} = True+isField Section {} = False++collect :: [(Text, FieldValue)] -> Fields+collect xs = Map.fromListWith (flip (++)) [(k, [v]) | (k, v) <- xs]++-- | Separate fields from sections. Consecutive sections form one group.+partitionFields :: [Field] -> (Fields, [[SectionInfo]])+partitionFields fields = (collect [(n, FieldValue p ls) | Field p n ls <- fields], groups fields)+  where+    groups xs = case dropWhile isField xs of+      [] -> []+      ys -> let (ss, rest) = break isField ys+            in [SectionInfo p n a b | Section p n a b <- ss] : groups rest++-- | Fields of a section that cannot contain sections.+plainFields :: [Field] -> Result Fields+plainFields body = case sections of+  SectionInfo p n _ _ : _ -> failAt p ("invalid subsection " <> T.pack (show n))+  [] -> Right fs+  where (fs, sections) = fmap concat (partitionFields body)++-- | The Cabal specification version for version digits, or 'Nothing' for an+-- unknown version.+knownSpec :: NonEmpty Integer -> Maybe Version+knownSpec ds = case NE.toList ds of+  v | v `elem` [[3, 18], [3, 16], [3, 14], [3, 12], [3, 8], [3, 6], [3, 4], [3, 0], [2, 4], [2, 2], [2, 0]] -> Just (specVersion v)+    | v >= [1, 25] -> Nothing+    | otherwise -> specVersion . snd <$> find ((v >=) . fst) older+  where+    older =+      [ ([1, 23], [1, 24]), ([1, 21], [1, 22]), ([1, 19], [1, 20]), ([1, 17], [1, 18])+      , ([1, 11], [1, 12]), ([1, 9], [1, 10]), ([1, 7], [1, 8]), ([1, 5], [1, 6])+      , ([1, 3], [1, 4]), ([1, 1], [1, 2]), ([], [1, 0]) ]++-- | The value of a @cabal-version@ field: a version or a range.+specVersionParser :: Version -> Parser Version+specVersionParser spec = do+  v <- versionParser <|> range+  maybe (fail ("Unknown cabal spec version specified: " ++ T.unpack (renderVersion v))) pure (knownSpec (versionNumbers v))+  where+    range = do+      v <- lowestVersion <$> rangeParser spec+      when (v >= specVersion [2, 1]) (fail "cabal-version higher than 2.2 cannot be specified as a range")+      pure v++-- | The smallest lower bound of a range. An empty range gives version 0.+lowestVersion :: VersionRange -> Version+lowestVersion range = case [v | ((v, _), _) <- intervals range] of+  [] -> zero+  vs -> minimum vs+  where+    zero = specVersion [0]+    intervals r = case r of+      AnyVersion -> [((zero, True), Nothing)]+      Equal v -> [((v, True), Just (v, True))]+      Later v -> [((v, False), Nothing)]+      AtLeast v -> [((v, True), Nothing)]+      Earlier v -> nonEmpty ((zero, True), Just (v, False))+      AtMost v -> [((zero, True), Just (v, True))]+      MajorBound v -> intervals (Both (AtLeast v) (Earlier (majorUpper v)))+      Both a b -> concat [nonEmpty (maxLower l1 l2, minUpper u1 u2) | (l1, u1) <- intervals a, (l2, u2) <- intervals b]+      EitherRange a b -> intervals a ++ intervals b+    nonEmpty i@((l, li), u) = case u of+      Nothing -> [i]+      Just (h, hi) | l < h || (l == h && li && hi) -> [i]+                   | otherwise -> []+    maxLower a@(v, i) b@(w, j)+      | v /= w = if v > w then a else b+      | otherwise = (v, i && j)+    minUpper Nothing u = u+    minUpper u Nothing = u+    minUpper (Just a@(v, i)) (Just b@(w, j))+      | v /= w = Just (if v < w then a else b)+      | otherwise = Just (v, i && j)+    majorUpper v = case NE.toList (versionNumbers v) of+      [x] -> specVersion [x, 1]+      x : y : _ -> specVersion [x, y + 1]+      [] -> zero++-- | Read the version on the first line, as in @cabal-version: 3.0@.+scanSpecVersion :: BS.ByteString -> Maybe Version+scanSpecVersion bytes = do+  line : _ <- Just (BS8.lines bytes)+  let normalized = BS.map lower (BS.filter (/= 0x20) line)+  [key, text] <- Just (BS8.split ':' normalized)+  guard (key == "cabal-version")+  v <- either (const Nothing) Just (runParser (versionParser <* space <* eof) "" (decode text))+  guard (length (versionNumbers v) `elem` [2, 3])+  pure v+  where+    lower w = if w > 0x40 && w < 0x5b then w + 0x20 else w++-- | Change a file without sections to the section format.+sectionize :: [Field] -> [Field]+sectionize fields+  | not (all isField fields) = fields+  | otherwise = header ++ library ++ executables exes0+  where+    name (Field _ n _) = n+    name (Section _ n _ _) = n+    (header0, exes0) = break ((== "executable") . name) fields+    (header, libraryFields0) = partition ((`notElem` libraryFieldNames) . name) header0+    (deps, libraryFields) = partition ((== "build-depends") . name) libraryFields0+    library = case libraryFields of+      [] -> []+      f : _ -> [Section (fieldPos f) "library" [] (deps ++ libraryFields)]+    executables (Field p "executable" ls : rest) =+      let (body, after) = break ((== "executable") . name) rest+          exeName = T.dropWhile (== ' ') (T.dropWhileEnd (== ' ') (T.intercalate "\n" (map fieldLineText ls)))+      in Section p "executable" [ArgName p exeName] (deps ++ body) : executables after+    executables _ = []+    fieldPos (Field p _ _) = p+    fieldPos (Section p _ _ _) = p++-- | Fields of the build information grammar of Cabal-syntax.+buildInfoFieldNames :: [Text]+buildInfoFieldNames =+  [ "buildable", "build-tools", "build-tool-depends", "cpp-options", "asm-options", "cmm-options"+  , "cc-options", "cxx-options", "ld-options", "hsc2hs-options", "pkgconfig-depends", "frameworks"+  , "extra-framework-dirs", "asm-sources", "cmm-sources", "c-sources", "cxx-sources", "js-sources"+  , "hs-source-dirs", "hs-source-dir", "other-modules", "virtual-modules", "autogen-modules"+  , "default-language", "other-languages", "default-extensions", "other-extensions", "extensions"+  , "extra-libraries", "extra-libraries-static", "extra-ghci-libraries", "extra-bundled-libraries"+  , "extra-library-flavours", "extra-dynamic-library-flavours", "extra-lib-dirs"+  , "extra-lib-dirs-static", "include-dirs", "includes", "autogen-includes", "install-includes"+  , "ghc-options", "ghcjs-options", "jhc-options", "hugs-options", "nhc98-options"+  , "ghc-prof-options", "ghcjs-prof-options", "ghc-shared-options", "ghcjs-shared-options"+  , "build-depends", "mixins" ]++libraryFieldNames :: [Text]+libraryFieldNames = ["exposed-modules", "reexported-modules", "signatures", "exposed"] ++ buildInfoFieldNames++data Kind = CommonKind | LibraryKind | ExecutableKind | TestKind | BenchmarkKind | ForeignKind+  deriving Eq++type Commons = Map Text (Conditional BuildInfo)++mergeTree :: Conditional BuildInfo -> Conditional BuildInfo -> Conditional BuildInfo+mergeTree (Conditional a bs) (Conditional b cs) = Conditional (mergeBuildInfo a b) (bs ++ cs)++isImport :: Field -> Bool+isImport (Field _ "import" _) = True+isImport _ = False++-- | Read the imports at the start of a list of fields. Cabal-syntax ignores+-- the other imports with a warning.+imports :: Version -> Commons -> [Field] -> Result ([Conditional BuildInfo], [Field])+imports spec commons+  | specAtLeast [2, 2] spec = go []+  | otherwise = \fields -> Right ([], filter (not . isImport) fields)+  where+    go acc (Field p "import" ls : rest) = do+      names <- parseField (commaList spec token) (FieldValue p ls)+      trees <- mapM (\n -> maybe (failAt p ("Undefined common stanza imported: " <> n)) Right (Map.lookup n commons)) names+      go (acc ++ trees) rest+    go acc rest = Right (acc, filter (not . isImport) rest)++stanza :: Version -> Kind -> Commons -> [Field] -> Result (Conditional BuildInfo)+stanza spec kind commons fields = do+  (imported, rest) <- imports spec commons fields+  tree <- condTree spec kind commons rest+  pure (foldr mergeTree tree imported)++condTree :: Version -> Kind -> Commons -> [Field] -> Result (Conditional BuildInfo)+condTree spec kind commons fields0 = do+  (imported, fields) <- if specAtLeast [3, 0] spec+    then imports spec commons fields0+    else Right ([], filter (not . isImport) fields0)+  let (fs, groups) = partitionFields fields+  info <- buildInfoFields spec kind fs+  branches' <- concat <$> mapM ifs groups+  pure (foldr mergeTree (Conditional info branches') imported)+  where+    subtree = condTree spec kind commons+    ifs [] = Right []+    ifs (SectionInfo p "if" args body : rest) = do+      c <- conditionAt p args+      yes <- subtree body+      (no, rest') <- elses rest+      pure (Branch c yes no : rest')+    ifs (_ : rest) = ifs rest+    elses (SectionInfo p "else" args body : rest) = do+      unless (null args) (failAt p "`else` section has section arguments")+      no <- subtree body+      rest' <- ifs rest+      pure (Just no, rest')+    elses (SectionInfo p "elif" args body : rest)+      | specAtLeast [2, 2] spec = do+          c <- conditionAt p args+          yes <- subtree body+          (no, rest') <- elses rest+          pure (Just (Conditional emptyBuildInfo [Branch c yes no]), rest')+      | otherwise = (,) Nothing <$> ifs rest+    elses rest = (,) Nothing <$> ifs rest+    conditionAt p args = maybe (failAt p "Invalid condition") Right (parseCondition args)++-- | Parse the fields of one section level. Fields that the Cabal+-- specification version does not support are ignored.+buildInfoFields :: Version -> Kind -> Fields -> Result BuildInfo+buildInfoFields spec kind fs = do+  mapM_ removed [([3, 0], "hs-source-dir"), ([3, 0], "extensions"), ([3, 0], "build-tools")]+  buildable' <- singular (parseField bool) (get "buildable")+  dirs <- monoidal (spaceList spec filePath) (get "hs-source-dirs")+  oldDirs <- monoidal (spaceList spec filePath) (get "hs-source-dir")+  exposed <- if kind == LibraryKind then modules (get "exposed-modules") else pure []+  other <- modules (get "other-modules")+  autogen <- modules (since [2, 0] "autogen-modules")+  virtual <- modules (since [2, 2] "virtual-modules")+  main <- if kind `elem` [ExecutableKind, TestKind, BenchmarkKind]+    then optionalField filePath (get "main-is") else pure Nothing+  language <- optionalField (quoted languageName) (since [1, 10] "default-language")+  otherLanguages' <- names (since [1, 10] "other-languages")+  extensions' <- names (since [1, 10] "default-extensions")+  otherExtensions' <- names (get "other-extensions")+  legacy <- names (get "extensions")+  deps <- monoidal (commaList spec (dependency spec)) (get "build-depends")+  mixins' <- monoidal (commaList spec (mixin spec)) (since [2, 0] "mixins")+  legacyTools <- monoidal (commaList spec (legacyExeDependency spec)) (get "build-tools")+  tools <- monoidal (commaList spec (exeDependency spec)) (get "build-tool-depends")+  cs <- paths (get "c-sources")+  cxx <- paths (since [2, 2] "cxx-sources")+  asm <- paths (since [3, 0] "asm-sources")+  cmm <- paths (since [3, 0] "cmm-sources")+  js <- paths (get "js-sources")+  includeDirs' <- paths (get "include-dirs")+  includes' <- paths (get "includes")+  installIncludes' <- paths (get "install-includes")+  autogenIncludes' <- paths (since [3, 0] "autogen-includes")+  libDirs <- paths (get "extra-lib-dirs")+  staticLibDirs <- paths (since [3, 8] "extra-lib-dirs-static")+  frameworks' <- monoidal (spaceList spec token) (get "frameworks")+  frameworkDirs <- paths (get "extra-framework-dirs")+  cpp <- options (get "cpp-options")+  cc <- options (get "cc-options")+  cxxOpts <- options (since [2, 2] "cxx-options")+  ghc <- options (get "ghc-options")+  -- Evaluate the other fields now. Then the parsed field lines are not kept.+  let !rest = Map.filterWithKey keep fs+  pure BuildInfo+    { buildable = buildable', sourceDirs = map T.unpack (dirs ++ oldDirs), exposedModules = exposed+    , otherModules = other, autogenModules = autogen, virtualModules = virtual+    , mainIs = T.unpack <$> main, defaultLanguage = language, otherLanguages = otherLanguages'+    , extensions = extensions', otherExtensions = otherExtensions', legacyExtensions = legacy+    , dependencies = deps, mixins = mixins', buildTools = legacyTools ++ tools, cSources = map T.unpack cs+    , cxxSources = map T.unpack cxx, asmSources = map T.unpack asm, cmmSources = map T.unpack cmm+    , jsSources = map T.unpack js, includeDirs = map T.unpack includeDirs'+    , includes = map T.unpack includes', installIncludes = map T.unpack installIncludes'+    , autogenIncludes = map T.unpack autogenIncludes', extraLibDirs = map T.unpack libDirs+    , extraLibDirsStatic = map T.unpack staticLibDirs, frameworks = frameworks'+    , extraFrameworkDirs = map T.unpack frameworkDirs, cppOptions = cpp, ccOptions = cc+    , cxxOptions = cxxOpts, ghcOptions = ghc, extraFields = rest+    }+  where+    get k = Map.findWithDefault [] k fs+    since v k = if specAtLeast v spec then get k else []+    removed (v, k) = case get k of+      fv : _ | specAtLeast v spec ->+        failAt (fieldPosition fv) ("The field " <> k <> " is removed in cabal-version " <> renderVersion (specVersion v))+      _ -> Right ()+    modules = monoidal (spaceList spec (quoted moduleName))+    names = monoidal (spaceList spec (quoted languageName))+    paths = monoidal (spaceList spec filePath)+    options = monoidal (optionList token')+    typed = typedFields ++ ["exposed-modules" | kind == LibraryKind]+      ++ ["main-is" | kind `elem` [ExecutableKind, TestKind, BenchmarkKind]]+    keep k _+      | k `elem` typed = False+      | kind == CommonKind = k `elem` buildInfoFieldNames || "x-" `T.isPrefixOf` k+      | otherwise = True++typedFields :: [Text]+typedFields =+  [ "buildable", "hs-source-dirs", "hs-source-dir", "other-modules", "autogen-modules"+  , "virtual-modules", "default-language", "other-languages", "default-extensions"+  , "other-extensions", "extensions", "build-depends", "mixins", "build-tools", "build-tool-depends"+  , "c-sources", "cxx-sources", "asm-sources", "cmm-sources", "js-sources", "include-dirs"+  , "includes", "install-includes", "autogen-includes", "extra-lib-dirs", "extra-lib-dirs-static"+  , "frameworks", "extra-framework-dirs", "cpp-options", "cc-options", "cxx-options", "ghc-options" ]++-- | The name argument of a component, common stanza, or flag section.+sectionName :: Position -> [SectionArg] -> Result Text+sectionName p args = case args of+  [ArgName _ x] -> Right x+  [ArgString _ x] -> Right x+  [] -> failAt p "name required"+  _ -> failAt p "Invalid name"++data State = State+  { stateCommons :: Commons+  , stateFlags :: [Flag]+  , stateComponents :: [Component (Conditional BuildInfo)]+  , stateRepositories :: [SourceRepository]+  , stateSetup :: Maybe [Dependency]+  }++-- | Parse a package description. First apply the Cabal-syntax patches for+-- known Hackage files. A patched file gets a warning, as in Cabal-syntax.+parsePackage :: BS.ByteString -> ParseResult Package+parsePackage input = case patchQuirks input of+  (patched, bytes) -> (report (parsePatched bytes))+    { parseWarnings = [Diagnostic Nothing "Legacy cabal file" | patched] }++parsePatched :: BS.ByteString -> Result Package+parsePatched bytes = do+  fields0 <- readInput bytes+  let (top, sections) = takeFields (sectionize fields0)+      get k = Map.findWithDefault [] k top+  spec <- case scanSpecVersion bytes of+    Just v -> maybe (failPackage "Unsupported cabal format version") Right (knownSpec (versionNumbers v))+    Nothing -> case get "cabal-version" of+      [] -> Right (specVersion [1, 0])+      values -> do+        v <- parseField (specVersionParser (specVersion [1, 24])) (last values)+        when (v >= specVersion [2, 2]) (failAt (fieldPosition (last values))+          "cabal-version should be at the beginning of the file starting with spec version 2.2")+        pure v+  parsedSpec <- optionalField (specVersionParser spec) (get "cabal-version")+  unless (fromMaybe (specVersion [1, 0]) parsedSpec == spec)+    (failPackage "Scanned and parsed cabal-versions don't match")+  pkg <- required "name" componentName top+  version <- required "version" versionParser top+  rawBuildType <- optionalField (buildTypeValue spec) (get "build-type")+  State _ flags components repositories setup <- foldM (section spec) (State Map.empty [] [] [] Nothing) sections+  let bt = fromMaybe (if specAtLeast [2, 2] spec && not (isJust setup) then "Simple" else "Custom") rawBuildType+      knownFlags = map flagName flags+  when (bt == "Custom" && not (isJust setup) && specAtLeast [1, 24] spec)+    (failPackage "Since cabal-version: 1.24 specifying custom-setup section is mandatory")+  when (bt == "Hooks" && not (isJust setup))+    (failPackage "Packages with build-type: Hooks require a custom-setup stanza")+  mapM_ (checkFlags knownFlags . componentData) components+  let libraries = [x | not (specAtLeast [3, 4] spec), Component (Library (NamedLibrary x)) _ <- components]+      internal = internalDependencies pkg libraries+      internalMixin m+        | mixinPackage m `elem` libraries, mixinLibrary m == MainLibrary =+            m {mixinPackage = pkg, mixinLibrary = if mixinPackage m == pkg then MainLibrary else NamedLibrary (mixinPackage m)}+        | otherwise = m+  pure Package+    { packageName = pkg, packageVersion = version, cabalVersion = spec, buildType = bt+    , packageFlags = flags+    , packageComponents =+        [ Component k (mapTree (\bi -> bi {dependencies = internal (dependencies bi), mixins = map internalMixin (mixins bi)}) t)+        | Component k t <- components ]+    , packageFields = top, packageSourceRepositories = repositories+    , packageSetupDependencies = internal <$> setup+    }++required :: Text -> Parser a -> Fields -> Result a+required key p fields = do+  value <- singular (parseField p) (Map.findWithDefault [] key fields)+  maybe (failPackage (T.pack (show key) <> " field missing")) Right value++section :: Version -> State -> Field -> Result State+section _ st Field {} = Right st+section spec st (Section p name args body) = case name of+  "common"+    | not (specAtLeast [2, 2] spec) -> Right st+    | otherwise -> do+        key <- sectionName p args+        tree <- stanza spec CommonKind commons body+        when (Map.member key commons) (failAt p ("Duplicate common stanza: " <> key))+        Right st {stateCommons = Map.insert key tree commons}+  "library"+    | null args -> do+        when (any isMainLibrary (stateComponents st))+          (failAt p "Multiple main libraries; have you forgotten to specify a name for an internal library?")+        component (Library MainLibrary) LibraryKind+    | otherwise -> sectionName p args >>= \n -> component (Library (NamedLibrary n)) LibraryKind+  "foreign-library" -> sectionName p args >>= \n -> component (ForeignLibrary n) ForeignKind+  "executable" -> sectionName p args >>= \n -> component (Executable n) ExecutableKind+  "test-suite" -> sectionName p args >>= \n -> component (TestSuite n) TestKind+  "benchmark" -> sectionName p args >>= \n -> component (Benchmark n) BenchmarkKind+  "flag" -> do+    n <- sectionName p args+    key <- either (failAt p) Right (runValue flagNameValue n)+    fields <- plainFields body+    let get k = Map.findWithDefault [] k fields+    def <- singular (parseField bool) (get "default")+    manual <- singular (parseField bool) (get "manual")+    let description = maybe "" (freeText spec . last) (nonEmpty (get "description"))+    Right st {stateFlags = stateFlags st ++ [Flag key (fromMaybe True def) (fromMaybe False manual) description]}+  "custom-setup" | null args -> do+    fields <- plainFields body+    deps <- monoidal (commaList spec (dependency spec)) (Map.findWithDefault [] "setup-depends" fields)+    Right st {stateSetup = Just deps}+  "source-repository" -> case args of+    [ArgName q kind] -> do+      kind' <- either (failAt q) Right (runValue (takeWhile1P Nothing (\c -> isAlphaNum c || c == '_' || c == '-')) kind)+      fields <- plainFields body+      Right st {stateRepositories = stateRepositories st ++ [SourceRepository kind' fields]}+    [] -> failAt p "'source-repository' requires exactly one argument"+    _ -> failAt p "Invalid source-repository kind"+  _ -> Right st+  where+    commons = stateCommons st+    component kind grammar = do+      tree <- stanza spec grammar commons body+      Right st {stateComponents = stateComponents st ++ [Component kind tree]}+    isMainLibrary (Component (Library MainLibrary) _) = True+    isMainLibrary _ = False+    nonEmpty [] = Nothing+    nonEmpty xs = Just xs++mapTree :: (BuildInfo -> BuildInfo) -> Conditional BuildInfo -> Conditional BuildInfo+mapTree f (Conditional bi bs) = Conditional (f bi) [Branch c (mapTree f t) (mapTree f <$> e) | Branch c t e <- bs]++-- | Before cabal-version 3.4, the name of an internal library refers to that+-- library of the same package. If the dependency also names other libraries,+-- Cabal-syntax 3.12 keeps the original dependency after the new one.+internalDependencies :: Text -> [Text] -> [Dependency] -> [Dependency]+internalDependencies pkg libraries = concatMap change+  where+    change d@(Dependency name range libs)+      | name `elem` libraries, MainLibrary `elem` libs =+          Dependency pkg range (NamedLibrary name :| []) : [d | any (/= MainLibrary) libs]+      | otherwise = [d]++checkFlags :: [Text] -> Conditional BuildInfo -> Result ()+checkFlags known tree = mapM_ check (branches tree)+  where+    check (Branch c t e) = checkCondition c *> checkFlags known t *> mapM_ (checkFlags known) e+    checkCondition c = case c of+      FlagValue f | f `notElem` known -> failPackage ("These flags are used without having been defined: " <> f)+      Not a -> checkCondition a+      And a b -> checkCondition a *> checkCondition b+      Or a b -> checkCondition a *> checkCondition b+      _ -> Right ()++-- | Read a @.buildinfo@ file, as Cabal-syntax reads hooked build information.+parseHookedBuildInfo :: BS.ByteString -> ParseResult HookedBuildInfo+parseHookedBuildInfo bytes = report $ do+  fields <- readInput bytes+  let (header, rest) = break isExecutable fields+  libraryFields <- plainFields header+  lib <- if Map.null libraryFields then pure Nothing else Just <$> buildInfoFields latestSpec CommonKind libraryFields+  exes <- groups rest+  ensureUnique (map fst exes)+  pure (HookedBuildInfo lib (Map.fromList exes))+  where+    isExecutable (Field _ "executable" _) = True+    isExecutable _ = False+    groups (Field p "executable" ls : rest) = do+      exe <- parseField componentName (FieldValue p ls)+      let (body, after) = break isExecutable rest+      fs <- plainFields body+      bi <- buildInfoFields latestSpec CommonKind fs+      ((exe, bi) :) <$> groups after+    groups _ = Right []+    ensureUnique names = case [n | (i, n) <- zip [0 :: Int ..] names, n `elem` take i names] of+      n : _ -> failPackage ("Duplicate executable: " <> n)+      [] -> Right ()

@@ -0,0 +1,224 @@+{-# LANGUAGE OverloadedStrings #-}+-- | Patches for known Hackage files. Cabal-syntax applies the same patches+-- before it parses a file. The data comes from+-- @Distribution.PackageDescription.Quirks@ in Cabal-syntax 3.18.1.0.+module Aihc.Cabal.Internal.Quirks (patchQuirks) where++import qualified Data.ByteString as BS+import qualified Data.ByteString.Unsafe as BSU+import qualified Data.Map.Strict as Map+import Foreign.Ptr (castPtr)+import GHC.Fingerprint (Fingerprint (..), fingerprintData)+import System.IO.Unsafe (unsafeDupablePerformIO)++-- | A change to the file bytes. Each change applies to the first match only.+data Edit+  = Replace BS.ByteString BS.ByteString+  -- ^ Replace the first match. If there is no match, keep the bytes.+  | Remove BS.ByteString+  -- ^ Remove the first match.+  | RemoveFrom BS.ByteString+  -- ^ Remove the first match and all bytes after it.++-- | Patch the bytes of a known file. 'True' shows that the bytes changed.+-- A patch applies only if the MD5 hash of the input and the MD5 hash of the+-- result are the expected values.+patchQuirks :: BS.ByteString -> (Bool, BS.ByteString)+patchQuirks bytes = case Map.lookup (md5 bytes) patches of+  Just (expected, edits)+    | md5 output == expected -> (True, output)+    where output = foldl (flip edit) bytes edits+  _ -> (False, bytes)++edit :: Edit -> BS.ByteString -> BS.ByteString+edit change bytes = case change of+  Replace needle new+    | BS.null after -> bytes+    | otherwise -> BS.concat [before, new, BS.drop (BS.length needle) after]+    where (before, after) = BS.breakSubstring needle bytes+  Remove needle -> case BS.breakSubstring needle bytes of+    (before, after) -> before <> BS.drop (BS.length needle) after+  RemoveFrom needle -> fst (BS.breakSubstring needle bytes)++md5 :: BS.ByteString -> Fingerprint+md5 bytes = unsafeDupablePerformIO $ BSU.unsafeUseAsCStringLen bytes $ \(ptr, size) ->+  fingerprintData (castPtr ptr) size++entry :: Fingerprint -> Fingerprint -> [Edit] -> (Fingerprint, (Fingerprint, [Edit]))+entry input output edits = (input, (output, edits))++-- | Each entry has the input hash, the result hash, and the changes in order.+patches :: Map.Map Fingerprint (Fingerprint, [Edit])+patches = Map.fromList+  [ -- unicode-transforms 0.3.3+    entry (Fingerprint 15958160436627155571 10318709190730872881) (Fingerprint 11008465475756725834 13815629925116264363)+      [Remove "  other-modules:\n      .\n"]+  , -- DSTM 0.1.2+    entry (Fingerprint 6919263071548559054 9050746360708965827) (Fingerprint 17015177514298962556 11943164891661867280)+      [Replace "Other modules:" "-- "]+  , -- DSTM 0.1.1+    entry (Fingerprint 17313105789069667153 9610429408495338584) (Fingerprint 17250946493484671738 17629939328766863497)+      [Replace "Other modules:" "-- "]+  , -- DSTM 0.1+    entry (Fingerprint 10502599650530614586 16424112934471063115) (Fingerprint 13562014713536696107 17899511905611879358)+      [Replace "Other modules:" "-- "]+  , -- control-monad-exception-mtl 0.10.3+    entry (Fingerprint 18274748422558568404 4043538769550834851) (Fingerprint 11395257416101232635 4303318131190196308)+      [Replace " default- extensions:" "unknown-section"]+  , -- vacuum-opengl 0.0+    entry (Fingerprint 5946760521961682577 16933361639326309422) (Fingerprint 14034745101467101555 14024175957788447824)+      [Remove "\DEL"]+  , -- vacuum-opengl 0.0.1+    entry (Fingerprint 10790950110330119503 1309560249972452700) (Fingerprint 1565743557025952928 13645502325715033593)+      [Remove "\DEL"]+  , -- ixset 1.0.4+    entry (Fingerprint 11886092342440414185 4150518943472101551) (Fingerprint 5731367240051983879 17473925006273577821)+      [RemoveFrom "{-"]+  , -- ds-kanren 0.2.0.0+    entry (Fingerprint 2804006762382336875 9677726932108735838) (Fingerprint 9830506174094917897 12812107316777006473)+      [Replace "Test-Suite test-list-ops:" "Test-Suite \"test-list-ops:\"", Replace "Test-Suite test-unify:" "Test-Suite \"test-unify:\""]+  , -- ds-kanren 0.2.0.1+    entry (Fingerprint 9130259649220396193 2155671144384738932) (Fingerprint 1847988234352024240 4597789823227580457)+      [Replace "Test-Suite test-list-ops:" "Test-Suite \"test-list-ops:\"", Replace "Test-Suite test-unify:" "Test-Suite \"test-unify:\""]+  , -- metric 0.1.4+    entry (Fingerprint 6150019278861565482 3066802658031228162) (Fingerprint 9124826020564520548 15629704249829132420)+      [Replace "test-suite metric-tests:" "test-suite \"metric-tests:\""]+  , -- metric 0.2.0+    entry (Fingerprint 4639805967994715694 7859317050376284551) (Fingerprint 5566222290622325231 873197212916959151)+      [Replace "test-suite metric-tests:" "test-suite \"metric-tests:\""]+  , -- phasechange 0.1+    entry (Fingerprint 10546509771395401582 245508422312751943) (Fingerprint 5169853482576003304 7247091607933993833)+      [Replace "impl(ghc >= 7.6):" "erroneous-section", Replace "impl(ghc >= 7.4):" "erroneous-section"]+  , -- smartword 0.0.0.5+    entry (Fingerprint 7803544783533485151 10807347873998191750) (Fingerprint 1665635316718752601 16212378357991151549)+      [Replace "build depends:" "--"]+  , -- shelltestrunner 1.3+    entry (Fingerprint 4403237110790078829 15392625961066653722) (Fingerprint 10218887328390239431 4644205837817510221)+      [Replace "other modules:" "--"]+  , -- hblas 0.2.0.0+    entry (Fingerprint 8570120150072467041 18315524331351505945) (Fingerprint 10838007242302656005 16026440017674974175)+      [Replace "&&!" "&& !"]+  , -- hblas 0.3.0.0+    entry (Fingerprint 5262875856214215155 10846626274067555320) (Fingerprint 3022954285783401045 13395975869915955260)+      [Replace "&&!" "&& !"]+  , -- hblas 0.3.0.1+    entry (Fingerprint 54222628930951453 5526514916844166577) (Fingerprint 1749630806887010665 8607076506606977549)+      [Replace "&&!" "&& !"]+  , -- hblas 0.3.1.0+    entry (Fingerprint 6817250511240350300 15278852712000783849) (Fingerprint 15757717081429529536 15542551865099640223)+      [Replace "&&!" "&& !"]+  , -- hblas 0.3.1.1+    entry (Fingerprint 8310050400349211976 201317952074418615) (Fingerprint 10283381191257209624 4231947623042413334)+      [Replace "&&!" "&& !"]+  , -- hblas 0.3.2.1+    entry (Fingerprint 7010988292906098371 11591884496857936132) (Fingerprint 6158672440010710301 6419743768695725095)+      [Replace "&&!" "&& !"]+  , -- hblas 0.3.2.1, revision 1+    entry (Fingerprint 2076850805659055833 16615160726215879467) (Fingerprint 10634706281258477722 5285812379517916984)+      [Replace "&&!" "&& !"]+  , -- hblas 0.3.2.1, revision 2+    entry (Fingerprint 11850020631622781099 11956481969231030830) (Fingerprint 13702868780337762025 13383526367149067158)+      [Replace "&&!" "&& !"]+  , -- hblas 0.4.0.0+    entry (Fingerprint 13690322768477779172 19704059263540994) (Fingerprint 11189374824645442376 8363528115442591078)+      [Replace "&&!" "&& !"]+  , -- brainheck 0.1.0.2+    entry (Fingerprint 6910727116443152200 15401634478524888973) (Fingerprint 16551412117098094368 16260377389127603629)+      [Replace "flag(llvm-fast)" "False"]+  , -- brainheck 0.1.0.2, revision 1+    entry (Fingerprint 14320987921316832277 10031098243571536929) (Fingerprint 7959395602414037224 13279941216182213050)+      [Replace "flag(llvm-fast)" "False"]+  , -- brainheck 0.1.0.2, revision 2+    entry (Fingerprint 3809078390223299128 10796026010775813741) (Fingerprint 1127231189459220796 12088367524333209349)+      [Replace "flag(llvm-fast)" "False"]+  , -- brainheck 0.1.0.2, revision 3+    entry (Fingerprint 13860013038089410950 12479824176801390651) (Fingerprint 4687484721703340391 8013395164515771785)+      [Replace "flag(llvm-fast)" "False"]+  , -- wordchoice 0.1.0.1+    entry (Fingerprint 16215911397419608203 15594928482155652475) (Fingerprint 15120681510314491047 2666192399775157359)+      [Replace "flag(llvm-fast)" "False"]+  , -- wordchoice 0.1.0.1, revision 1+    entry (Fingerprint 16593139224723441188 4052919014346212001) (Fingerprint 3577381082410411593 11481899387780544641)+      [Replace "flag(llvm-fast)" "False"]+  , -- wordchoice 0.1.0.2+    entry (Fingerprint 9321301260802539374 1316392715016096607) (Fingerprint 3784628652257760949 12662640594755291035)+      [Replace "flag(llvm-fast)" "False"]+  , -- wordchoice 0.1.0.2, revision 1+    entry (Fingerprint 2546901804824433337 2059732715322561176) (Fingerprint 8082068680348326500 615008613291421947)+      [Replace "flag(llvm-fast)" "False"]+  , -- wordchoice 0.1.0.3+    entry (Fingerprint 2282380737467965407 12457554753171662424) (Fingerprint 17324757216926991616 17172911843227482125)+      [Replace "flag(llvm-fast)" "False"]+  , -- wordchoice 0.1.0.3, revision 1+    entry (Fingerprint 12907988890480595481 11078473638628359710) (Fingerprint 13246185333368731848 4663060731847518614)+      [Replace "flag(llvm-fast)" "False"]+  , -- hw-prim-bits 0.1.0.0+    entry (Fingerprint 12386777729082870356 17414156731912743711) (Fingerprint 3452290353395041602 14102887112483033720)+      [Replace "flag(sse42)" "False"]+  , -- hw-prim-bits 0.1.0.1+    entry (Fingerprint 6870520675313101180 14553457351296240636) (Fingerprint 12481021059537696455 14711088786769892762)+      [Replace "flag(sse42)" "False"]+  , -- Sit 0.2017.2.26+    entry (Fingerprint 8458530898096910998 3228538743646501413) (Fingerprint 14470502514907936793 17514354054641875371)+      [Replace "0.2017.02.26" "0.2017.2.26"]+  , -- Sit 0.2017.5.1+    entry (Fingerprint 1450130849535097473 11742099607098860444) (Fingerprint 16679762943850814021 4253724355613883542)+      [Replace "0.2017.05.01" "0.2017.5.1"]+  , -- Sit 0.2017.5.2+    entry (Fingerprint 297248532398492441 17322625167861324800) (Fingerprint 634812045126693280 1755581866539318862)+      [Replace "0.2017.05.02" "0.2017.5.2"]+  , -- Sit 0.2017.5.2, revision 1+    entry (Fingerprint 3697869560530373941 3942982281026987312) (Fingerprint 14344526114710295386 16386400353475114712)+      [Replace "0.2017.5.02" "0.2017.5.2"]+  , -- MiniAgda 0.2017.2.18+    entry (Fingerprint 17167128953451088679 4300350537748753465) (Fingerprint 12402236925293025673 7715084875284020606)+      [Replace "0.2017.02.18" "0.2017.2.18"]+  , -- fast-downward 0.1.0.0+    entry (Fingerprint 11256076039027887363 6867903407496243216) (Fingerprint 12159816716813155434 5278015399212299853)+      [Replace "1.2.03.0" "1.2.3.0"]+  , -- fast-downward 0.1.0.0, revision 1+    entry (Fingerprint 9216193973149680231 893446343655828508) (Fingerprint 10020169545407746427 1828336750379510675)+      [Replace "1.2.03.0" "1.2.3.0"]+  , -- fast-downward 0.1.0.1+    entry (Fingerprint 9899886602574848632 5980433644983783334) (Fingerprint 12007469255857289958 8321466548645225439)+      [Replace "1.2.03.0" "1.2.3.0"]+  , -- fast-downward 0.1.1.0+    entry (Fingerprint 12694656661460787751 1902242956706735615) (Fingerprint 15433152131513403849 2284712791516353264)+      [Replace "1.2.03.0" "1.2.3.0"]+  , -- SGplus 1.1+    entry (Fingerprint 17735649550442248029 11493772714725351354) (Fingerprint 9565458801063261772 15955773698774721052)+      [Replace "1000000000" "100000000"]+  , -- control-dotdotdot 0.1.0.1+    entry (Fingerprint 1514257173776509942 7756050823377346485) (Fingerprint 14082092642045505999 18415918653404121035)+      [Replace "9223372036854775807" "5"]+  , -- data-foldapp 0.1.1.0+    entry (Fingerprint 4511234156311243251 11701153011544112556) (Fingerprint 11820542702491924189 4902231447612406724)+      [Replace "9223372036854775807" "999", Replace "9223372036854775807" "999"]+  , -- data-list-zigzag 0.1.1.1+    entry (Fingerprint 12475837388692175691 18053834261188158945) (Fingerprint 16279938253437334942 15753349540193002309)+      [Replace "9223372036854775807" "999"]+  , -- nat 0.1+    entry (Fingerprint 9222512268705577108 13085311382746579495) (Fingerprint 17468921266614378430 13221316288008291892)+      [Replace "\xf6" "\xc3\xb6"]+  , -- streaming-bracketed 0.1.0.0+    entry (Fingerprint 14670044663153191927 1427497586294143829) (Fingerprint 9233007756654759985 6571998449003682006)+      [Replace "cabal-version:       2" "cabal-version: 2.0"]+  , -- streaming-bracketed 0.1.0.1+    entry (Fingerprint 7298738862909203815 10141693276062967842) (Fingerprint 1349949738792220441 3593683359695349293)+      [Replace "cabal-version:       2" "cabal-version: 2.0"]+  , -- zsyntax 0.2.0.0+    entry (Fingerprint 17812331267506881875 3005293725141563863) (Fingerprint 3445957263137759540 12472369104312474458)+      [Replace "cabal-version:  2" "cabal-version: 2.0"]+  , -- wai-middleware-hmac-client 0.1.0.1+    entry (Fingerprint 3112606538775065787 11984607507024462091) (Fingerprint 6916432989977230500 6621389616675138128)+      [Replace "\"\"" "."]+  , -- wai-middleware-hmac-client 0.1.0.2+    entry (Fingerprint 12566783342663020458 17562089389615949789) (Fingerprint 15745683452603944938 10556498036622072844)+      [Replace "\"\"" "."]+  , -- reheat 0.1.4+    entry (Fingerprint 9155400339287317061 14812953666990892802) (Fingerprint 7687053346032173923 15384472501136606592)+      [Replace "/home/palo/dev/haskell-workspace/playground/reheat/gpl-3.0.txt" ""]+  , -- reheat 0.1.5+    entry (Fingerprint 2984391146441073709 11728234882049907993) (Fingerprint 12058479081855347701 14017937756688869826)+      [Replace "/home/palo/dev/haskell-workspace/playground/reheat/gpl-3.0.txt" ""]+  ]

@@ -0,0 +1,64 @@+{-# LANGUAGE OverloadedStrings #-}+-- | Condition evaluation and flag resolution.+module Aihc.Cabal.Internal.Resolve (evaluateCondition, resolvePackage, packageFieldText) where++import qualified Data.Map.Strict as Map+import Data.Maybe (fromMaybe)+import Data.Text (Text)+import qualified Data.Text as T+import Aihc.Cabal.Internal.Types+import Aihc.Cabal.Internal.Values (freeText)+import Aihc.Cabal.Internal.Version (withinRange)++-- | Evaluate a condition for a target and a flag assignment. A flag that is+-- not in the assignment is 'False'. Names of operating systems,+-- architectures, and compilers compare without case.+evaluateCondition :: Environment -> FlagAssignment -> Condition -> Bool+evaluateCondition env flags cond = case cond of+  Literal b -> b+  OS x -> T.toLower x == T.toLower (targetOS env)+  Arch x -> T.toLower x == T.toLower (targetArch env)+  Impl x range -> T.toLower x == T.toLower (compiler env) && withinRange (compilerVersion env) range+  FlagValue x -> Map.findWithDefault False x flags+  Not a -> not (evaluateCondition env flags a)+  And a b -> evaluateCondition env flags a && evaluateCondition env flags b+  Or a b -> evaluateCondition env flags a || evaluateCondition env flags b++-- | Evaluate the conditions of all components and apply defaults.+--+-- The flag assignment is the given assignment over the flag defaults of the+-- package. A given flag that the package does not declare has no effect.+-- The active parts of each component merge in source order with the+-- 'Semigroup' instance of t'BuildInfo'. Then an absent 'buildable' becomes+-- 'True', and an empty 'sourceDirs' becomes @[\".\"]@. An absent+-- 'defaultLanguage' stays 'Nothing'.+--+-- The result has all components. The caller selects the components to+-- build.+resolvePackage :: Environment -> FlagAssignment -> Package -> ResolvedPackage+resolvePackage env overrides pkg = ResolvedPackage flags components+  where+    defaults = Map.fromList [(flagName f, flagDefault f) | f <- packageFlags pkg]+    flags = Map.union (Map.intersection overrides defaults) defaults+    components = [Component k (finish (resolve t)) | Component k t <- packageComponents pkg]+    resolve (Conditional info bs) = mconcat (info : concatMap branch bs)+    branch (Branch c t e)+      | evaluateCondition env flags c = [resolve t]+      | otherwise = maybe [] (pure . resolve) e+    finish bi = bi+      { buildable = Just (fromMaybe True (buildable bi))+      , sourceDirs = if null (sourceDirs bi) then ["."] else sourceDirs bi+      }++-- | The text of a package field, such as @description@ or @synopsis@, after+-- the Cabal free text rules of the file's format version. If the field+-- occurs more than one time, the last value wins, as in Cabal-syntax. The+-- result is 'Nothing' for an absent field.+--+-- Before @cabal-version@ 3.0, each line loses its leading and trailing+-- spaces, and a line with one dot becomes an empty line. From+-- @cabal-version@ 3.0, the text keeps blank lines and relative indentation.+packageFieldText :: Package -> Text -> Maybe Text+packageFieldText pkg name = case Map.findWithDefault [] (T.toLower name) (packageFields pkg) of+  [] -> Nothing+  values -> Just (freeText (cabalVersion pkg) (last values))

@@ -0,0 +1,402 @@+{-# LANGUAGE OverloadedStrings #-}+-- | The data types of the library. "Aihc.Cabal" exports all of them.+--+-- The types keep the data of a Cabal file as the file gives it. Names,+-- modules, and options are 'Text'. Paths are 'FilePath', because the caller+-- joins them with directories. A scalar field that is absent is 'Nothing'.+-- A list field that is absent is @[]@. Defaults are applied by+-- 'Aihc.Cabal.resolvePackage', not by the parser.+module Aihc.Cabal.Internal.Types where++import Data.List (nub)+import Data.List.NonEmpty (NonEmpty)+import Data.Map.Strict (Map)+import qualified Data.Map.Strict as Map+import Data.Text (Text)+import qualified Data.Text as T+import Aihc.Cabal.Internal.Version (Version, VersionRange)++-- * Positions and diagnostics++-- | A source position. Rows start at 1. Columns start at 1 and count UTF-8+-- bytes, as in Cabal-syntax.+data Position = Position+  { positionRow :: !Int+  , positionColumn :: !Int+  } deriving (Eq, Ord, Show)++-- | An error or a warning from the parser. A check of the complete package+-- has no position.+data Diagnostic = Diagnostic+  { diagnosticPosition :: Maybe Position+  , diagnosticMessage :: Text+  } deriving (Eq, Show)++-- | The result of a parse. The parser stops at the first error, so the+-- error side holds one diagnostic. Warnings are present with an error and+-- with a value. The parser gives one warning: @Legacy cabal file@ for a+-- file that gets a Cabal-syntax patch.+data ParseResult a = ParseResult+  { parseWarnings :: [Diagnostic]+  , parseValue :: Either Diagnostic a+  } deriving (Eq, Show)++-- * Field values++-- | One line of a field value. The text has no leading spaces or line break.+data FieldLine = FieldLine+  { fieldLinePosition :: !Position+  , fieldLineText :: !Text+  } deriving (Eq, Show)++-- | A field value as the source file gives it. The position is the position+-- of the field name. The lines are in source order. Comment lines and blank+-- lines are not included.+--+-- Field values occur in 'packageFields', 'extraFields', and+-- 'sourceRepositoryFields'. The parser does not check these values.+data FieldValue = FieldValue+  { fieldPosition :: !Position+  , fieldLines :: [FieldLine]+  } deriving (Eq, Show)++-- | The lines of a field value, joined with line breaks. For a free text+-- field, such as @description@, use 'Aihc.Cabal.packageFieldText'.+fieldText :: FieldValue -> Text+fieldText = T.intercalate "\n" . map fieldLineText . fieldLines++-- * Dependencies++-- | A library of a package. 'MainLibrary' is the library without a name.+data LibraryTarget = MainLibrary | NamedLibrary Text deriving (Eq, Ord, Show)++-- | One entry of a @build-depends@ or @setup-depends@ field.+--+-- Before @cabal-version@ 3.4, a dependency on the name of an internal+-- library of the same package refers to that library. The parser changes+-- such a dependency to the package name and the 'NamedLibrary' target.+data Dependency = Dependency+  { dependencyPackage :: Text+  , dependencyRange :: VersionRange+  -- ^ 'Aihc.Cabal.anyVersion' when the field gives no range.+  , dependencyLibraries :: NonEmpty LibraryTarget+  -- ^ The libraries in @pkg:{a, b}@ syntax. Without that syntax, the main+  -- library.+  } deriving (Eq, Show)++-- | Module visibility for a mixin or a package dependency.+data ModuleRenaming+  = DefaultRenaming+  -- ^ All exposed modules with their names.+  | ModuleRenaming [(Text, Text)]+  -- ^ Only the given modules, each with a new name.+  | HidingRenaming [Text]+  -- ^ All exposed modules except the given modules.+  deriving (Eq, Show)++-- | A Backpack mixin from a @mixins@ field.+data Mixin = Mixin+  { mixinPackage :: Text+  , mixinLibrary :: LibraryTarget+  , mixinProvides :: ModuleRenaming+  , mixinRequires :: ModuleRenaming+  } deriving (Eq, Show)++-- | One entry of a @build-tool-depends@ or a legacy @build-tools@ field.+data ToolDependency = ToolDependency+  { toolPackage :: Maybe Text+  -- ^ The package in @pkg:exe@ syntax. 'Nothing' for a @build-tools@ entry,+  -- which names only the tool.+  , toolName :: Text+  , toolRange :: VersionRange+  -- ^ 'Aihc.Cabal.anyVersion' when the field gives no range.+  } deriving (Eq, Show)++-- * Flags and conditions++-- | A @flag@ section. Flag names are lower case.+data Flag = Flag+  { flagName :: Text+  , flagDefault :: Bool+  -- ^ The @default@ field. 'True' when the field is absent.+  , flagManual :: Bool+  -- ^ The @manual@ field. 'False' when the field is absent.+  , flagDescription :: Text+  -- ^ The @description@ field after the Cabal free text rules. @\"\"@ when+  -- the field is absent.+  } deriving (Eq, Show)++-- | Flag values by flag name.+type FlagAssignment = Map Text Bool++-- | The condition of an @if@ or @elif@ section.+data Condition+  = Literal Bool+  | OS Text+  -- ^ @os(name)@. The comparison ignores case.+  | Arch Text+  -- ^ @arch(name)@. The comparison ignores case.+  | Impl Text VersionRange+  -- ^ @impl(compiler range)@. Without a range, 'Aihc.Cabal.anyVersion'.+  -- The comparison of the compiler name ignores case.+  | FlagValue Text+  -- ^ @flag(name)@. The name is lower case.+  | Not Condition+  | And Condition Condition+  | Or Condition Condition+  deriving (Eq, Show)++-- | Data with conditional parts, as one section of a Cabal file gives it.+-- 'unconditional' holds the fields outside @if@ sections. 'branches' holds+-- the @if@ sections in source order.+data Conditional a = Conditional+  { unconditional :: a+  , branches :: [Branch a]+  } deriving (Eq, Show)++-- | An @if@ section with its optional @else@ or @elif@ part. An @elif@ part+-- becomes an @else@ part with one branch.+data Branch a = Branch+  { condition :: Condition+  , whenTrue :: Conditional a+  , whenFalse :: Maybe (Conditional a)+  } deriving (Eq, Show)++-- * Components++-- | The kind and name of a component section.+data ComponentKind+  = Library LibraryTarget+  | Executable Text+  | TestSuite Text+  | Benchmark Text+  | ForeignLibrary Text+  deriving (Eq, Ord, Show)++-- | A component of a package. In a t'Package', the data is a+-- @t'Conditional' t'BuildInfo'@. In a t'ResolvedPackage', the data is a+-- t'BuildInfo'.+data Component a = Component+  { componentKind :: ComponentKind+  , componentData :: a+  } deriving (Eq, Show)++-- | The build fields of one section level, before defaults. Lists keep+-- their source order. A field that the Cabal format version of the file+-- does not support is absent.+--+-- The 'Semigroup' instance merges two parts as Cabal-syntax merges build+-- information. Values in the second part come after values in the first+-- part. Some lists do not keep duplicate values. A scalar value in the+-- second part replaces the scalar value in the first part. The parser uses+-- the merge for common stanza imports. 'Aihc.Cabal.resolvePackage' uses it+-- for active conditional branches.+data BuildInfo = BuildInfo+  { buildable :: Maybe Bool+  -- ^ @buildable@. Two values merge with 'Bool' and.+  , sourceDirs :: [FilePath]+  -- ^ @hs-source-dirs@, then the older @hs-source-dir@ values.+  , exposedModules :: [Text]+  -- ^ @exposed-modules@. Only a library has this field.+  , otherModules :: [Text]+  -- ^ @other-modules@.+  , autogenModules :: [Text]+  -- ^ @autogen-modules@, from @cabal-version@ 2.0.+  , virtualModules :: [Text]+  -- ^ @virtual-modules@, from @cabal-version@ 2.2.+  , mainIs :: Maybe FilePath+  -- ^ @main-is@. Only an executable, a test suite, or a benchmark has this+  -- field.+  , defaultLanguage :: Maybe Text+  -- ^ @default-language@, from @cabal-version@ 1.10. 'Nothing' means the+  -- Haskell98 default of Cabal.+  , otherLanguages :: [Text]+  -- ^ @other-languages@, from @cabal-version@ 1.10.+  , extensions :: [Text]+  -- ^ @default-extensions@, from @cabal-version@ 1.10.+  , otherExtensions :: [Text]+  -- ^ @other-extensions@.+  , legacyExtensions :: [Text]+  -- ^ The older @extensions@ field. It is an error from @cabal-version@ 3.0.+  -- Use it with 'extensions' when you select compiler extensions.+  , dependencies :: [Dependency]+  -- ^ @build-depends@.+  , mixins :: [Mixin]+  -- ^ @mixins@, from @cabal-version@ 2.0.+  , buildTools :: [ToolDependency]+  -- ^ The legacy @build-tools@ values, then the @build-tool-depends@ values.+  , cSources :: [FilePath]+  -- ^ @c-sources@.+  , cxxSources :: [FilePath]+  -- ^ @cxx-sources@, from @cabal-version@ 2.2.+  , asmSources :: [FilePath]+  -- ^ @asm-sources@, from @cabal-version@ 3.0.+  , cmmSources :: [FilePath]+  -- ^ @cmm-sources@, from @cabal-version@ 3.0.+  , jsSources :: [FilePath]+  -- ^ @js-sources@.+  , includeDirs :: [FilePath]+  -- ^ @include-dirs@.+  , includes :: [FilePath]+  -- ^ @includes@.+  , installIncludes :: [FilePath]+  -- ^ @install-includes@.+  , autogenIncludes :: [FilePath]+  -- ^ @autogen-includes@, from @cabal-version@ 3.0.+  , extraLibDirs :: [FilePath]+  -- ^ @extra-lib-dirs@.+  , extraLibDirsStatic :: [FilePath]+  -- ^ @extra-lib-dirs-static@, from @cabal-version@ 3.8.+  , frameworks :: [Text]+  -- ^ @frameworks@.+  , extraFrameworkDirs :: [FilePath]+  -- ^ @extra-framework-dirs@.+  , cppOptions :: [Text]+  -- ^ @cpp-options@. Options keep all values, also duplicates.+  , ccOptions :: [Text]+  -- ^ @cc-options@.+  , cxxOptions :: [Text]+  -- ^ @cxx-options@, from @cabal-version@ 2.2.+  , ghcOptions :: [Text]+  -- ^ @ghc-options@.+  , extraFields :: Map Text [FieldValue]+  -- ^ All other fields of the section, by lower case name, with their values+  -- in source order. This includes @x-@ fields, for example+  -- @x-aihc-lir-sources@. Use 'fieldText' to read a value.+  } deriving (Eq, Show)++-- | A t'BuildInfo' without fields. Use it with record syntax to make a value.+emptyBuildInfo :: BuildInfo+emptyBuildInfo = BuildInfo+  { buildable = Nothing, sourceDirs = [], exposedModules = [], otherModules = []+  , autogenModules = [], virtualModules = [], mainIs = Nothing, defaultLanguage = Nothing+  , otherLanguages = [], extensions = [], otherExtensions = [], legacyExtensions = []+  , dependencies = [], mixins = [], buildTools = [], cSources = [], cxxSources = [], asmSources = []+  , cmmSources = [], jsSources = [], includeDirs = [], includes = [], installIncludes = []+  , autogenIncludes = [], extraLibDirs = [], extraLibDirsStatic = [], frameworks = []+  , extraFrameworkDirs = [], cppOptions = [], ccOptions = [], cxxOptions = []+  , ghcOptions = [], extraFields = Map.empty+  }++-- | Merge two parts. See the 'Semigroup' instance of t'BuildInfo'.+mergeBuildInfo :: BuildInfo -> BuildInfo -> BuildInfo+mergeBuildInfo a b = BuildInfo+  { buildable = case (buildable a, buildable b) of+      (Nothing, y) -> y+      (x, Nothing) -> x+      (Just x, Just y) -> Just (x && y)+  , sourceDirs = unique sourceDirs+  , exposedModules = both exposedModules+  , otherModules = unique otherModules+  , autogenModules = unique autogenModules+  , virtualModules = unique virtualModules+  , mainIs = prefer (mainIs a) (mainIs b)+  , defaultLanguage = prefer (defaultLanguage a) (defaultLanguage b)+  , otherLanguages = unique otherLanguages+  , extensions = unique extensions+  , otherExtensions = unique otherExtensions+  , legacyExtensions = unique legacyExtensions+  , dependencies = unique dependencies+  , mixins = both mixins+  , buildTools = both buildTools+  , cSources = unique cSources+  , cxxSources = unique cxxSources+  , asmSources = unique asmSources+  , cmmSources = unique cmmSources+  , jsSources = unique jsSources+  , includeDirs = unique includeDirs+  , includes = unique includes+  , installIncludes = unique installIncludes+  , autogenIncludes = unique autogenIncludes+  , extraLibDirs = unique extraLibDirs+  , extraLibDirsStatic = unique extraLibDirsStatic+  , frameworks = unique frameworks+  , extraFrameworkDirs = unique extraFrameworkDirs+  , cppOptions = both cppOptions+  , ccOptions = both ccOptions+  , cxxOptions = both cxxOptions+  , ghcOptions = both ghcOptions+  , extraFields = Map.unionWith (++) (extraFields a) (extraFields b)+  }+  where+    both f = f a ++ f b+    unique f = nub (both f)+    prefer x Nothing = x+    prefer _ y = y++instance Semigroup BuildInfo where+  (<>) = mergeBuildInfo++instance Monoid BuildInfo where+  mempty = emptyBuildInfo++-- * Packages++-- | A @source-repository@ section. Repeated fields keep their values in+-- source order. The values keep quotation marks.+data SourceRepository = SourceRepository+  { sourceRepositoryKind :: Text+  -- ^ The section argument, for example @head@ or @this@.+  , sourceRepositoryFields :: Map Text [FieldValue]+  } deriving (Eq, Show)++-- | A parsed package description. Conditions are not evaluated. Use+-- 'Aihc.Cabal.resolvePackage' to get a t'ResolvedPackage'.+data Package = Package+  { packageName :: Text+  , packageVersion :: Version+  , cabalVersion :: Version+  -- ^ The Cabal format version that Cabal-syntax uses for the file. A range+  -- such as @>=1.9@ gives the version that Cabal-syntax selects, here 1.10.+  -- A file without a @cabal-version@ field has version 1.0.+  , buildType :: Text+  -- ^ The build type that Cabal-syntax uses: @Simple@, @Configure@,+  -- @Custom@, @Make@, or @Hooks@. Without a @build-type@ field, the value is+  -- @Simple@ from @cabal-version@ 2.2 and @Custom@ before it. A+  -- @custom-setup@ section gives @Custom@.+  , packageFlags :: [Flag]+  -- ^ The @flag@ sections in source order.+  , packageComponents :: [Component (Conditional BuildInfo)]+  -- ^ The component sections in source order.+  , packageFields :: Map Text [FieldValue]+  -- ^ All fields before the first section, by lower case name, with their+  -- values in source order. This includes @name@, @version@,+  -- @cabal-version@, and @build-type@. Use 'Aihc.Cabal.packageFieldText'+  -- to read a value.+  , packageSourceRepositories :: [SourceRepository]+  -- ^ The @source-repository@ sections in source order.+  , packageSetupDependencies :: Maybe [Dependency]+  -- ^ The @setup-depends@ values of a @custom-setup@ section. 'Nothing'+  -- without that section.+  } deriving (Eq, Show)++-- | The target that 'Aihc.Cabal.evaluateCondition' compares with. The+-- library does not read the host platform or an installed compiler.+data Environment = Environment+  { targetOS :: Text+  -- ^ For @os(...)@, for example @linux@. Case does not matter.+  , targetArch :: Text+  -- ^ For @arch(...)@, for example @x86_64@. Case does not matter.+  , compiler :: Text+  -- ^ For @impl(...)@, for example @ghc@. Case does not matter.+  , compilerVersion :: Version+  -- ^ The version that the compiler reports.+  } deriving (Eq, Show)++-- | A package after condition evaluation and defaults. See+-- 'Aihc.Cabal.resolvePackage'.+data ResolvedPackage = ResolvedPackage+  { resolvedFlags :: FlagAssignment+  -- ^ The value of each declared flag.+  , resolvedComponents :: [Component BuildInfo]+  -- ^ All components, in source order. This includes components with+  -- @buildable: False@. The caller selects the components to build.+  } deriving (Eq, Show)++-- | The contents of a @.buildinfo@ file, as a configure script writes it.+data HookedBuildInfo = HookedBuildInfo+  { hookedLibrary :: Maybe BuildInfo+  -- ^ The fields before the first @executable@ field.+  , hookedExecutables :: Map Text BuildInfo+  -- ^ The fields after each @executable: name@ field.+  } deriving (Eq, Show)

@@ -0,0 +1,298 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE OverloadedStrings #-}+-- | Parsers for field values, and the free text rules. Each parser follows+-- the Cabal-syntax 3.12 parser for the same value.+module Aihc.Cabal.Internal.Values+  ( runValue, token, token', filePath, quoted, commaList, spaceList, optionList+  , componentName, moduleName, identifier, languageName, bool, buildTypeValue+  , dependency, exeDependency, legacyExeDependency, mixin, flagNameValue, specAtLeast, freeText+  ) where++import Control.Applicative (optional, (<|>))+import Control.Monad (void, when)+import Data.Char (chr, digitToInt, isAlpha, isAlphaNum, isDigit, isHexDigit, isOctDigit, isSpace, isUpper, toLower)+import Data.List.NonEmpty (NonEmpty (..))+import Data.Maybe (catMaybes, fromMaybe)+import Data.Text (Text)+import qualified Data.Text as T+import Text.Megaparsec (between, choice, eof, errorBundlePretty, getInput, many, manyTill, option, runParser, satisfy, some, takeP, takeWhile1P, takeWhileP, try)+import Text.Megaparsec.Char (char, space, spaceChar, string)+import Aihc.Cabal.Internal.Types+import Aihc.Cabal.Internal.Version++specAtLeast :: [Integer] -> Version -> Bool+specAtLeast digits spec = spec >= specVersion digits++-- | Run a field parser on complete field text, as Cabal-syntax does.+runValue :: Parser a -> Text -> Either Text a+runValue p input = case runParser (space *> p <* space <* eof) "field" input of+  Left err -> Left (T.pack (errorBundlePretty err))+  Right x -> Right x++-- | A Haskell string literal.+haskellString :: Parser Text+haskellString = T.pack . catMaybes <$> (char '"' *> manyTill stringChar (char '"'))+  where+    stringChar = Just <$> satisfy (\c -> c /= '"' && c /= '\\' && c > '\026') <|> (char '\\' *> escape)+    escape = Nothing <$ (some (satisfy isSpace) *> char '\\')+      <|> Nothing <$ char '&'+      <|> Just <$> escapeCode+    escapeCode = choice (map (\(c, code) -> code <$ char c) (zip "abfnrtv\\\"'" "\a\b\f\n\r\t\v\\\"'"))+      <|> number 10 isDigit (pure ())+      <|> number 8 isOctDigit (void (char 'o'))+      <|> number 16 isHexDigit (void (char 'x'))+      <|> choice [try (code <$ string name) | (name, code) <- asciiCodes]+      <|> (char '^' *> ((\c -> chr (fromEnum c - fromEnum '@')) <$> satisfy (\c -> isUpper c || c == '@')))+    number :: Int -> (Char -> Bool) -> Parser () -> Parser Char+    number base valid prefix = do+      prefix+      ds <- some (satisfy valid)+      let n = foldl (\a d -> a * base + digitToInt d) 0 ds+      if n > 0x10FFFF then fail "out-of-range numeric escape sequence" else pure (chr n)+    asciiCodes = zip+      [ "NUL", "SOH", "STX", "ETX", "EOT", "ENQ", "ACK", "BEL", "DLE", "DC1", "DC2", "DC3", "DC4"+      , "NAK", "SYN", "ETB", "CAN", "SUB", "ESC", "DEL", "BS", "HT", "LF", "VT", "FF", "CR", "SO"+      , "SI", "EM", "FS", "GS", "RS", "US", "SP" ]+      "\NUL\SOH\STX\ETX\EOT\ENQ\ACK\BEL\DLE\DC1\DC2\DC3\DC4\NAK\SYN\ETB\CAN\SUB\ESC\DEL\BS\HT\LF\VT\FF\CR\SO\SI\EM\FS\GS\RS\US\SP"++-- | A string or characters other than space and comma.+token :: Parser Text+token = haskellString <|> takeWhile1P (Just "identifier") (\c -> not (isSpace c) && c /= ',')++-- | A string or characters other than space.+token' :: Parser Text+token' = haskellString <|> takeWhile1P (Just "token") (not . isSpace)++-- | A token that is not empty.+filePath :: Parser Text+filePath = do+  x <- token+  when (T.null x) (fail "empty FilePath")+  pure x++quoted :: Parser a -> Parser a+quoted p = between (char '"') (char '"') p <|> p++comma :: Parser ()+comma = char ',' *> space++-- | The list format of @CommaVCat@ and @CommaFSep@ fields.+commaList :: Version -> Parser a -> Parser [a]+commaList spec p+  | specAtLeast [2, 2] spec = do+      c <- optional comma+      case c of+        Nothing -> sepEndBy1 item comma <|> pure []+        Just _ -> sepBy1 item comma+  | otherwise = sepBy item comma+  where item = p <* space++-- | The list format of @VCat@ and @FSep@ fields.+spaceList :: Version -> Parser a -> Parser [a]+spaceList spec p+  | specAtLeast [3, 0] spec = do+      c <- optional comma+      case c of+        Nothing -> start <|> pure []+        Just _ -> sepBy1 item comma+  | otherwise = sepBy item (optional comma)+  where+    item = p <* space+    start = do+      x <- item+      c <- optional comma+      case c of+        Nothing -> (x :) <$> many item+        Just _ -> (x :) <$> sepEndBy item comma++-- | The list format of @NoCommaFSep@ fields.+optionList :: Parser a -> Parser [a]+optionList p = many (p <* space)++sepBy :: Parser a -> Parser s -> Parser [a]+sepBy p s = sepBy1 p s <|> pure []++sepBy1 :: Parser a -> Parser s -> Parser [a]+sepBy1 p s = (:) <$> p <*> many (s *> p)++sepEndBy :: Parser a -> Parser s -> Parser [a]+sepEndBy p s = sepEndBy1 p s <|> pure []++sepEndBy1 :: Parser a -> Parser s -> Parser [a]+sepEndBy1 p s = do+  x <- p+  (s *> ((x :) <$> sepEndBy p s)) <|> pure [x]++-- | Take the longest prefix that the predicate accepts, if the check accepts+-- that prefix. Otherwise use the fallback parser. The result is a slice of the+-- input: a list of characters is not kept.+validPrefix :: (Char -> Bool) -> (Text -> Bool) -> Parser Text -> Parser Text+validPrefix allowed valid fallback = do+  input <- getInput+  let x = T.takeWhile allowed input+  if valid x then takeP Nothing (T.length x) else fallback++-- | A package or component name. Each part has a letter.+componentName :: Parser Text+componentName = validPrefix (\c -> isAlphaNum c || c == '-') valid (T.pack <$> state0 [])+  where+    valid x = not (T.null x) && all (\part -> not (T.null part) && not (T.all isDigit part)) (T.splitOn "-" x)+    ch = satisfy (\c -> isAlphaNum c || c == '-')+    state0 acc = do+      c <- ch+      if isDigit c then state0 (c : acc)+        else if isAlphaNum c then state1 (c : acc)+        else fail ("Empty component, after " ++ reverse acc)+    state1 acc = (do+      c <- ch+      if isAlphaNum c then state1 (c : acc) else state0 (c : acc)) <|> pure (reverse acc)++moduleName :: Parser Text+moduleName = validPrefix (\c -> isAlphaNum c || c == '_' || c == '\'' || c == '.') valid (T.pack <$> state0 [])+  where+    valid x = not (T.null x) && all (\part -> maybe False (isUpper . fst) (T.uncons part)) (T.splitOn "." x)+    state0 acc = do+      c <- satisfy isUpper+      state1 (c : acc)+    state1 acc = (do+      c <- satisfy (\c -> isAlphaNum c || c == '_' || c == '\'' || c == '.')+      if c == '.' then state0 (c : acc) else state1 (c : acc)) <|> pure (reverse acc)++-- | A name for an operating system or an architecture.+identifier :: Parser Text+identifier = T.cons <$> satisfy isAlpha <*> takeWhileP Nothing (\c -> isAlphaNum c || c == '_' || c == '-')++languageName :: Parser Text+languageName = takeWhile1P (Just "name") isAlphaNum++bool :: Parser Bool+bool = do+  x <- takeWhile1P (Just "boolean") isAlpha+  case T.toLower x of+    "true" -> pure True+    "false" -> pure False+    _ -> fail ("Not a boolean: " ++ T.unpack x)++-- | A build type. @Default@ is @Custom@ before cabal-version 1.20.+-- @Make@ is not permitted from cabal-version 3.18. @Hooks@ is permitted+-- from cabal-version 3.14.+buildTypeValue :: Version -> Parser Text+buildTypeValue spec = do+  x <- takeWhile1P (Just "build type") isAlphaNum+  case x of+    _ | x `elem` ["Simple", "Configure", "Custom"] -> pure x+    "Make" | not (specAtLeast [3, 18] spec) -> pure x+           | otherwise -> fail "build-type: 'Make'. This feature requires cabal-version <= 3.18."+    "Hooks" | specAtLeast [3, 14] spec -> pure x+            | otherwise -> fail "build-type: 'Hooks'. This feature requires cabal-version >= 3.14."+    "Default" | not (specAtLeast [1, 20] spec) -> pure "Custom"+    _ -> fail ("unknown build-type: '" ++ T.unpack x ++ "'")++flagNameValue :: Parser Text+flagNameValue = do+  c <- satisfy (\x -> isAlphaNum x || x == '_')+  rest <- takeWhileP Nothing (\x -> isAlphaNum x || x == '_' || x == '-')+  pure (T.map toLower (T.cons c rest))++dependency :: Version -> Parser Dependency+dependency spec = do+  name <- componentName+  libs <- optional $ do+    _ <- char ':'+    unless3 (fail "Sublibrary dependency syntax used")+    ((:| []) <$> library) <|> between (char '{' *> space) (space *> char '}') libraries+  space+  range <- optional (rangeParser spec)+  let normalize (NamedLibrary x) | x == name = MainLibrary+      normalize x = x+      -- Most dependencies have no library list. They share one value.+      !targets = maybe mainLibrary (fmap normalize) libs+  pure (Dependency name (fromMaybe anyVersion range) targets)+  where+    unless3 failure = when (not (specAtLeast [3, 0] spec)) failure+    library = NamedLibrary <$> componentName+    libraries = do+      x <- library <* space+      xs <- many (comma *> library <* space)+      pure (x :| xs)++mainLibrary :: NonEmpty LibraryTarget+mainLibrary = MainLibrary :| []+{-# NOINLINE mainLibrary #-}++exeDependency :: Version -> Parser ToolDependency+exeDependency spec = do+  pkg <- componentName+  _ <- char ':'+  exe <- componentName <* space+  range <- optional (rangeParser spec)+  pure (ToolDependency (Just pkg) exe (fromMaybe anyVersion range))++legacyExeDependency :: Version -> Parser ToolDependency+legacyExeDependency spec = do+  name <- quoted legacyName+  space+  range <- optional (quoted (rangeParser spec))+  pure (ToolDependency Nothing name (fromMaybe anyVersion range))+  where+    legacyName = T.intercalate "-" <$> sepBy1 part (char '-')+    part = do+      x <- takeWhile1P (Just "name") (\c -> isAlphaNum c || c == '+' || c == '_')+      if T.all isDigit x then fail "invalid component" else pure x++-- | A mixin: a package, an optional library, and module renamings.+mixin :: Version -> Parser Mixin+mixin spec = do+  pkg <- componentName+  lib <- option MainLibrary $ do+    _ <- char ':'+    when (not (specAtLeast [3, 4] spec)) (fail "Sublibrary mixin syntax used")+    NamedLibrary <$> componentName+  space+  provides <- renaming+  requires <- option DefaultRenaming (try (space *> string "requires" *> space *> renaming))+  let lib' = case lib of+        NamedLibrary x | x == pkg -> MainLibrary+        _ -> lib+  pure (Mixin pkg lib' provides requires)+  where+    lax = specAtLeast [3, 0] spec+    parens p+      | lax = between (char '(' *> space) (char ')' *> space) p+      | otherwise = between (char '(' *> optional (spaceChar *> fail "space after parenthesis")) (char ')') p+    listed = if lax then moduleName <* space else moduleName+    renaming = choice+      [ ModuleRenaming <$> parens (sepBy entry comma) <* space+      , HidingRenaming <$> (string "hiding" *> space *> parens (sepBy listed comma))+      , pure DefaultRenaming ]+    entry = do+      old <- moduleName <* space+      option (old, old) $ do+        _ <- string "as"+        _ <- some (satisfy isSpace)+        new <- moduleName <* space+        pure (old, new)++-- | Cabal-syntax gives free text with two sets of rules. From cabal-version+-- 3.0, it keeps blank lines and relative indentation.+freeText :: Version -> FieldValue -> Text+freeText spec (FieldValue pos ls) = case ls of+  [] -> ""+  _ | specAtLeast [3, 0] spec -> freeText3 pos ls+  [FieldLine _ "."] -> "."+  _ -> T.intercalate "\n" [if t == "." then "" else t | FieldLine _ x <- ls, let t = T.strip x]++freeText3 :: Position -> [FieldLine] -> Text+freeText3 _ [] = ""+freeText3 _ [FieldLine _ x] = x+freeText3 pos (FieldLine p1 x1 : rest@(FieldLine p2 _ : _))+  | positionRow pos == positionRow p1 = T.concat (x1 : lines' (minimum (column p1 : column p2 : map lineColumn rest)))+  | otherwise =+      let c = minimum (column p1 : map lineColumn rest)+      in T.concat (T.replicate (column p1 - c) " " : x1 : lines' c)+  where+    column = positionColumn+    lineColumn = column . fieldLinePosition+    lines' c = zipWith (line c) (p1 : map fieldLinePosition rest) rest+    line c previous (FieldLine q x) =+      T.replicate (positionRow q - positionRow previous) "\n" <> T.replicate (column q - c) " " <> x

@@ -0,0 +1,234 @@+{-# LANGUAGE OverloadedStrings #-}+-- | Versions and version ranges. "Aihc.Cabal" exports the public part. The+-- parsers and the specification version helpers are for the other internal+-- modules.+module Aihc.Cabal.Internal.Version+  ( -- * Public+    Version, versionNumbers, mkVersion, parseVersion, renderVersion+  , VersionRange (..), anyVersion, noVersion, thisVersion, withinVersion, withinRange, intersectRanges+  , unionRanges, parseVersionRange, renderVersionRange+    -- * Internal+  , Parser, specVersion, latestSpec, versionParser, versionDigits, rangeParser+  ) where++import Control.Applicative ((<|>))+import Control.Monad (when)+import Data.Char (isAlphaNum, isDigit)+import Data.List.NonEmpty (NonEmpty (..))+import qualified Data.List.NonEmpty as NE+import Data.Text (Text)+import qualified Data.Text as T+import Data.Void (Void)+import Text.Megaparsec (Parsec, between, eof, errorBundlePretty, many, runParser, satisfy, sepBy1, some, takeWhile1P)+import Text.Megaparsec.Char (char, space, string)++-- | A version: one or more numbers that are not negative. Versions compare+-- as lists, so @1.2@ is before @1.2.0@.+newtype Version = Version (NonEmpty Integer) deriving (Eq, Ord, Show)++-- | A version range as a Cabal file gives it. The constructors are exported+-- so that the caller can examine, simplify, or show a range. Equality is+-- structural: a @^>=@ bound and its expanded intersection are different+-- values. Use 'withinRange' to test membership.+data VersionRange+  = AnyVersion+  -- ^ @-any@, or an absent range. The same set of versions as @>= 0@.+  | Equal Version+  -- ^ @== v@+  | Later Version+  -- ^ @> v@+  | Earlier Version+  -- ^ @< v@+  | AtLeast Version+  -- ^ @>= v@+  | AtMost Version+  -- ^ @<= v@+  | MajorBound Version+  -- ^ @^>= v@+  | Both VersionRange VersionRange+  -- ^ @a && b@+  | EitherRange VersionRange VersionRange+  -- ^ @a || b@+  deriving (Eq, Show)++type Parser = Parsec Void Text++-- | The numbers of a version.+versionNumbers :: Version -> NonEmpty Integer+versionNumbers (Version ns) = ns++-- | Make a version from its numbers. The result is 'Nothing' for an empty+-- list and for a negative number.+mkVersion :: [Integer] -> Maybe Version+mkVersion ns = case NE.nonEmpty ns of+  Just xs | all (>= 0) xs -> Just (Version xs)+  _ -> Nothing++-- | A known Cabal specification version, for example @specVersion [2, 2]@.+specVersion :: [Integer] -> Version+specVersion = Version . NE.fromList++-- | The newest Cabal specification version that the parser knows.+latestSpec :: Version+latestSpec = specVersion [3, 14]++-- | A version number part: at most nine digits and no leading zero.+versionDigits :: Parser Integer+versionDigits = do+  ds <- some (satisfy isDigit)+  case ds of+    "0" -> pure 0+    '0' : _ -> fail "Version digit with leading zero"+    _ | length ds > 9 -> fail "At most 9 numbers are allowed per version number part"+      | otherwise -> pure (read ds)++-- | A version with optional tags, for example @1.2.3-rc1@. The tags are not kept.+versionParser :: Parser Version+versionParser = Version . NE.fromList <$> versionDigits `sepBy1` char '.' <* tags++tags :: Parser ()+tags = () <$ many (char '-' *> some (satisfy isAlphaNum))++parseWith :: Parser a -> Text -> Either Text a+parseWith p input = case runParser (space *> p <* space <* eof) "" input of+  Left err -> Left (T.pack (errorBundlePretty err))+  Right value -> Right value++-- | Parse a version such as @9.12.2@. Spaces around the version are+-- permitted. Tags such as @-rc1@ are accepted and not kept.+parseVersion :: Text -> Either Text Version+parseVersion = parseWith versionParser++-- | Show a version with dots, as in @9.12.2@.+renderVersion :: Version -> Text+renderVersion (Version ns) = T.intercalate "." (map (T.pack . show) (NE.toList ns))++-- | The range of all versions.+anyVersion :: VersionRange+anyVersion = AnyVersion++-- | The empty range @-none@, as @< 0@.+noVersion :: VersionRange+noVersion = Earlier (Version (0 :| []))++-- | The range @== v@.+thisVersion :: Version -> VersionRange+thisVersion = Equal++-- | The range @a && b@ or @a || b@. The functions do not simplify.+intersectRanges, unionRanges :: VersionRange -> VersionRange -> VersionRange+intersectRanges = Both+unionRanges = EitherRange++-- | Test if a version is in a range.+withinRange :: Version -> VersionRange -> Bool+withinRange v range = case range of+  AnyVersion -> True+  Equal w -> v == w+  Later w -> v > w+  Earlier w -> v < w+  AtLeast w -> v >= w+  AtMost w -> v <= w+  MajorBound w -> v >= w && v < majorUpperBound w+  Both a b -> withinRange v a && withinRange v b+  EitherRange a b -> withinRange v a || withinRange v b++-- | Parse a version range as Cabal-syntax does for the given specification version.+-- Unparenthesized @&&@ and @||@ associate to the right.+rangeParser :: Version -> Parser VersionRange+rangeParser spec = expr+  where+    expr = do+      space+      t <- term+      space+      (EitherRange t <$> (string "||" *> space *> expr)) <|> pure t+    term = do+      f <- factor+      space+      (Both f <$> (string "&&" *> space *> term)) <|> pure f+    factor = parens <|> prim+    parens = between (char '(' *> space) (char ')' *> space) (expr <* space)+    prim = do+      op <- takeWhile1P (Just "operator") isOpChar+      case op of+        "-" -> AnyVersion <$ string "any" <|> (string "none" *> none)+        "==" -> space *> (wildOrVersion <|> (versionSet >>= set Equal))+        "^>=" -> space *> (major <|> (versionSet >>= set MajorBound))+        _ -> do+          space+          (wild, v) <- versionOrWild+          when wild (fail ("wild-card version after non-== operator: " ++ T.unpack op))+          case op of+            ">=" -> pure (AtLeast v)+            "<" -> pure (Earlier v)+            "<=" -> pure (AtMost v)+            ">" -> pure (Later v)+            _ -> fail ("Unknown version operator " ++ T.unpack op)+    isOpChar c = c `elem` ("<=>^" :: String) || (c == '-' && spec < specVersion [3, 4])+    none+      | spec >= specVersion [1, 22] = pure noVersion+      | otherwise = fail "-none version range used"+    wildOrVersion = do+      (wild, v) <- versionOrWild+      pure (if wild then withinVersion v else Equal v)+    major = do+      (wild, v) <- versionOrWild+      when wild (fail "wild-card version after ^>= operator")+      if spec >= specVersion [2, 0] then pure (MajorBound v)+        else fail "major bounded version syntax (caret, ^>=) used"+    set constructor vs+      | spec >= specVersion [3, 0] = pure (foldr1 EitherRange (fmap constructor vs))+      | otherwise = fail "version set syntax used"+    versionSet = do+      _ <- char '{' *> space+      v <- plain <* space+      vs <- many (char ',' *> space *> plain <* space)+      _ <- char '}'+      pure (v :| vs)+    plain = Version . NE.fromList <$> versionDigits `sepBy1` char '.'+    versionOrWild = versionDigits >>= loop . pure+    loop acc = (char '.' *> ((versionDigits >>= loop . (: acc)) <|> ((True, done acc) <$ char '*')))+      <|> ((False, done acc) <$ tags)+    done = Version . NE.fromList . reverse++-- | The range @== v.*@.+withinVersion :: Version -> VersionRange+withinVersion v = Both (AtLeast v) (Earlier (wildcardUpperBound v))+wildcardUpperBound :: Version -> Version+wildcardUpperBound (Version ns) = Version (NE.fromList (NE.init ns ++ [NE.last ns + 1]))++majorUpperBound :: Version -> Version+majorUpperBound (Version ns) = Version $ case ns of+  x :| [] -> x :| [1]+  x :| (y:_) -> x :| [y + 1]++-- | Parse a version range. The parser accepts the syntax of all Cabal+-- format versions: @-any@, @-none@, @^>=@, and version sets. Operators+-- without parentheses associate to the right, as in Cabal-syntax.+parseVersionRange :: Text -> Either Text VersionRange+parseVersionRange = parseWith (rangeParser (specVersion [3, 0]))++-- | Show a range in Cabal syntax, for example @>=1.2 && <1.3 || ==2.0@.+-- The text has parentheses only where the structure needs them. A @||@+-- operand of @&&@ gets parentheses. A left operand with the same operator+-- gets parentheses, so that 'parseVersionRange' gives the same value.+renderVersionRange :: VersionRange -> Text+renderVersionRange r = case r of+  AnyVersion -> "-any"+  Equal v -> "==" <> renderVersion v+  Later v -> ">" <> renderVersion v+  Earlier v -> "<" <> renderVersion v+  AtLeast v -> ">=" <> renderVersion v+  AtMost v -> "<=" <> renderVersion v+  MajorBound v -> "^>=" <> renderVersion v+  Both a b -> parens (isBoth a || isEither a) a <> " && " <> parens (isEither b) b+  EitherRange a b -> parens (isEither a) a <> " || " <> renderVersionRange b+  where+    parens needed x+      | needed = "(" <> renderVersionRange x <> ")"+      | otherwise = renderVersionRange x+    isBoth Both {} = True+    isBoth _ = False+    isEither EitherRange {} = True+    isEither _ = False

@@ -0,0 +1,259 @@+{-# LANGUAGE OverloadedStrings #-}+module Compliance.Adapter (toCabal, runResult) where++import Control.Monad (foldM)+import Data.List.NonEmpty (NonEmpty)+import qualified Data.List.NonEmpty as NE+import qualified Data.Map.Strict as Map+import Data.Maybe (fromMaybe)+import Data.Text (Text)+import qualified Data.Text as T+import qualified Data.Text.Encoding as TE+import qualified Aihc.Cabal as A+import qualified Distribution.CabalSpecVersion as C+import qualified Distribution.Compat.NonEmptySet as NES+import qualified Distribution.Compiler as C+import qualified Distribution.FieldGrammar.Parsec as C+import qualified Distribution.Fields.Field as C+import qualified Distribution.Fields.ParseResult as C+import qualified Distribution.PackageDescription as C+import qualified Distribution.PackageDescription.FieldGrammar as C+import qualified Distribution.Parsec as C+import qualified Distribution.Types.Version as C+import qualified Distribution.Types.VersionRange as C+import qualified Distribution.Utils.Path as C++-- Only fields retained as text use Cabal field grammars. Typed fields use+-- the project AST. This module cannot read the original file or reference AST.+toCabal :: A.Package -> Either String C.GenericPackageDescription+toCabal pkg = do+  spec <- maybe (Left "Unsupported Cabal format version") Right+    (C.cabalSpecFromVersionDigits (map fromInteger (NE.toList (A.versionNumbers (A.cabalVersion pkg)))))+  -- The typed name, version, and format version replace the retained text.+  let retained = foldr Map.delete (A.packageFields pkg) ["name", "version", "cabal-version"]+  pd <- fields spec C.packageDescriptionFieldGrammar+    (Map.insert "name" [text (A.packageName pkg)] (Map.insert "version" [text "0"] retained))+  repositories <- traverse (sourceRepository spec) (A.packageSourceRepositories pkg)+  flags <- traverse (flag spec) (A.packageFlags pkg)+  version <- convertVersion (A.packageVersion pkg)+  -- The grammar tells if the file sets a build type. The value is typed.+  buildType <- traverse (const (atom (A.buildType pkg))) (C.buildTypeRaw pd)+  setup <- traverse (fmap (\deps -> C.SetupBuildInfo deps False) . traverse convertDependency)+    (A.packageSetupDependencies pkg)+  let description = pd+        { C.package = C.PackageIdentifier (C.mkPackageName (T.unpack (A.packageName pkg))) version+        , C.specVersion = spec+        , C.buildTypeRaw = buildType+        , C.setupBuildInfo = setup+        , C.sourceRepos = repositories+        }+      initial = C.emptyGenericPackageDescription+        { C.packageDescription = description, C.genPackageFlags = flags }+  foldM (component spec) initial (A.packageComponents pkg)++flag :: C.CabalSpecVersion -> A.Flag -> Either String C.PackageFlag+flag spec f = do+  raw <- fields spec (C.flagFieldGrammar (C.mkFlagName (T.unpack (A.flagName f))))+    (Map.singleton "description" [text (A.flagDescription f)])+  pure raw { C.flagDefault = A.flagDefault f, C.flagManual = A.flagManual f }++sourceRepository :: C.CabalSpecVersion -> A.SourceRepository -> Either String C.SourceRepo+sourceRepository spec repository = do+  kind <- atom (A.sourceRepositoryKind repository)+  fields spec (C.sourceRepoFieldGrammar kind) (A.sourceRepositoryFields repository)++fields :: C.CabalSpecVersion -> C.ParsecFieldGrammar s a -> Map.Map Text [A.FieldValue] -> Either String a+fields spec grammar retained = either (Left . show) Right+  (snd (runResult (C.parseFieldGrammar spec (fieldMap retained) grammar)))+  where+    -- Keep each occurrence, each line, and each source position.+    fieldMap = Map.fromList . map (\(k, vs) -> (TE.encodeUtf8 k, map value vs)) . Map.toList+    value (A.FieldValue p ls) = C.MkNamelessField (position p)+      [C.FieldLine (position q) (TE.encodeUtf8 line) | A.FieldLine q line <- ls]+    position (A.Position row column) = C.Position row column++-- | Run a Cabal-syntax parser without a source name. The results keep the+-- error and warning format of Cabal-syntax 3.12.+runResult :: C.ParseResult () a+  -> ([C.PWarning], Either (Maybe C.Version, NonEmpty C.PError) a)+runResult result = case C.runParseResult result of+  (warnings, outcome) -> (map C.pwarning warnings, either (Left . fmap (fmap C.perror)) Right outcome)++-- | A field value for text that has no source position. Each line gets a+-- new row, so that Cabal free text rules give the same text.+text :: Text -> A.FieldValue+text value = A.FieldValue (A.Position 0 0)+  [A.FieldLine (A.Position row 1) line | not (T.null value), (row, line) <- zip [1 ..] (T.splitOn "\n" value)]++-- | Cabal-syntax makes these paths without checks or normalization.+path :: FilePath -> C.SymbolicPathX allowAbsolute from to+path = C.unsafeMakeSymbolicPath++atom :: C.Parsec a => Text -> Either String a+atom input = maybe (Left ("Cannot convert field value: " ++ T.unpack input)) Right (C.simpleParsec (T.unpack input))++convertVersion :: A.Version -> Either String C.Version+convertVersion v = do+  let digits = NE.toList (A.versionNumbers v)+  if any (> toInteger (maxBound :: Int)) digits+    then Left "Version component exceeds the Cabal integer limit"+    else Right (C.mkVersion (map fromInteger digits))++convertRange :: A.VersionRange -> Either String C.VersionRange+convertRange range = case range of+  A.AnyVersion -> Right C.anyVersion+  A.Equal v -> C.thisVersion <$> convertVersion v+  A.Later v -> C.laterVersion <$> convertVersion v+  A.Earlier v -> C.earlierVersion <$> convertVersion v+  A.AtLeast v -> C.orLaterVersion <$> convertVersion v+  A.AtMost v -> C.orEarlierVersion <$> convertVersion v+  A.MajorBound v -> C.majorBoundVersion <$> convertVersion v+  A.Both a b -> C.intersectVersionRanges <$> convertRange a <*> convertRange b+  A.EitherRange a b -> C.unionVersionRanges <$> convertRange a <*> convertRange b++convertDependency :: A.Dependency -> Either String C.Dependency+convertDependency dep = do+  range <- convertRange (A.dependencyRange dep)+  pure (C.Dependency (C.mkPackageName (T.unpack (A.dependencyPackage dep))) range+    (NES.fromNonEmpty (fmap target (A.dependencyLibraries dep))))+  where+    target A.MainLibrary = C.LMainLibName+    target (A.NamedLibrary name) = C.LSubLibName (C.mkUnqualComponentName (T.unpack name))++convertMixin :: A.Mixin -> Either String C.Mixin+convertMixin (A.Mixin pkg lib provides requires) = do+  provides' <- renaming provides+  requires' <- renaming requires+  pure (C.Mixin (C.mkPackageName (T.unpack pkg)) (library lib) (C.IncludeRenaming provides' requires'))+  where+    library A.MainLibrary = C.LMainLibName+    library (A.NamedLibrary name) = C.LSubLibName (C.mkUnqualComponentName (T.unpack name))+    renaming A.DefaultRenaming = Right C.DefaultRenaming+    renaming (A.ModuleRenaming pairs) = C.ModuleRenaming <$> traverse (\(a, b) -> (,) <$> atom a <*> atom b) pairs+    renaming (A.HidingRenaming names) = C.HidingRenaming <$> traverse atom names++convertBuildInfo :: C.BuildInfo -> A.BuildInfo -> Either String C.BuildInfo+convertBuildInfo raw bi = do+  other <- traverse atom (A.otherModules bi)+  autogen <- traverse atom (A.autogenModules bi)+  virtual <- traverse atom (A.virtualModules bi)+  language <- traverse atom (A.defaultLanguage bi)+  otherLanguages <- traverse atom (A.otherLanguages bi)+  extensions <- traverse atom (A.extensions bi)+  otherExtensions <- traverse atom (A.otherExtensions bi)+  legacyExtensions <- traverse atom (A.legacyExtensions bi)+  dependencies <- traverse convertDependency (A.dependencies bi)+  mixins <- traverse convertMixin (A.mixins bi)+  modern <- traverse modernTool [t | t <- A.buildTools bi, Just _ <- [A.toolPackage t]]+  legacy <- traverse legacyTool [t | t <- A.buildTools bi, Nothing <- [A.toolPackage t]]+  let C.PerCompilerFlavor _ ghcjs = C.options raw+  pure raw+    { C.buildable = fromMaybe True (A.buildable bi)+    , C.hsSourceDirs = map path (A.sourceDirs bi)+    , C.otherModules = other+    , C.autogenModules = autogen+    , C.virtualModules = virtual+    , C.defaultLanguage = language+    , C.otherLanguages = otherLanguages+    , C.defaultExtensions = extensions+    , C.otherExtensions = otherExtensions+    , C.oldExtensions = legacyExtensions+    , C.targetBuildDepends = dependencies+    , C.mixins = mixins+    , C.buildTools = legacy+    , C.buildToolDepends = modern+    , C.cSources = map path (A.cSources bi)+    , C.cxxSources = map path (A.cxxSources bi)+    , C.asmSources = map path (A.asmSources bi)+    , C.cmmSources = map path (A.cmmSources bi)+    , C.jsSources = map path (A.jsSources bi)+    , C.includeDirs = map path (A.includeDirs bi)+    , C.includes = map path (A.includes bi)+    , C.installIncludes = map path (A.installIncludes bi)+    , C.autogenIncludes = map path (A.autogenIncludes bi)+    , C.extraLibDirs = map path (A.extraLibDirs bi)+    , C.extraLibDirsStatic = map path (A.extraLibDirsStatic bi)+    , C.frameworks = map (path . T.unpack) (A.frameworks bi)+    , C.extraFrameworkDirs = map path (A.extraFrameworkDirs bi)+    , C.cppOptions = map T.unpack (A.cppOptions bi)+    , C.ccOptions = map T.unpack (A.ccOptions bi)+    , C.cxxOptions = map T.unpack (A.cxxOptions bi)+    , C.options = C.PerCompilerFlavor (map T.unpack (A.ghcOptions bi)) ghcjs+    }+  where+    modernTool tool = case A.toolPackage tool of+      Nothing -> Left "Missing build tool package"+      Just name -> C.ExeDependency (C.mkPackageName (T.unpack name))+        (C.mkUnqualComponentName (T.unpack (A.toolName tool))) <$> convertRange (A.toolRange tool)+    legacyTool tool = C.LegacyExeDependency (T.unpack (A.toolName tool)) <$> convertRange (A.toolRange tool)++convertCondition :: A.Condition -> Either String (C.Condition C.ConfVar)+convertCondition cond = case cond of+  A.Literal b -> Right (C.Lit b)+  A.OS name -> C.Var . C.OS <$> atom name+  A.Arch name -> C.Var . C.Arch <$> atom name+  A.Impl name range -> C.Var <$> (C.Impl <$> atom name <*> convertRange range)+  A.FlagValue name -> Right (C.Var (C.PackageFlag (C.mkFlagName (T.unpack name))))+  A.Not a -> C.CNot <$> convertCondition a+  A.And a b -> C.CAnd <$> convertCondition a <*> convertCondition b+  A.Or a b -> C.COr <$> convertCondition a <*> convertCondition b++convertTree :: (A.BuildInfo -> Either String a)+  -> A.Conditional A.BuildInfo -> Either String (C.CondTree C.ConfVar a)+convertTree convert (A.Conditional bi branches) = do+  value <- convert bi+  children <- traverse branch branches+  pure (C.CondNode value children)+  where+    branch (A.Branch cond yes no) = C.CondBranch <$> convertCondition cond+      <*> convertTree convert yes <*> traverse (convertTree convert) no++component :: C.CabalSpecVersion -> C.GenericPackageDescription+  -> A.Component (A.Conditional A.BuildInfo) -> Either String C.GenericPackageDescription+component spec gpd (A.Component kind tree) = case kind of+  A.Library target -> do+    let libName = case target of+          A.MainLibrary -> C.LMainLibName+          A.NamedLibrary n -> C.LSubLibName (componentName n)+    converted <- convertTree (library libName) tree+    pure $ case target of+      A.MainLibrary -> gpd { C.condLibrary = Just converted }+      A.NamedLibrary n -> gpd { C.condSubLibraries = C.condSubLibraries gpd ++ [(componentName n, converted)] }+  A.Executable name -> do+    converted <- convertTree (executable (componentName name)) tree+    pure gpd { C.condExecutables = C.condExecutables gpd ++ [(componentName name, converted)] }+  A.ForeignLibrary name -> do+    converted <- convertTree (foreignLibrary (componentName name)) tree+    pure gpd { C.condForeignLibs = C.condForeignLibs gpd ++ [(componentName name, converted)] }+  A.TestSuite name -> do+    converted <- convertTree testSuite tree+    pure gpd { C.condTestSuites = C.condTestSuites gpd ++ [(componentName name, converted)] }+  A.Benchmark name -> do+    converted <- convertTree benchmark tree+    pure gpd { C.condBenchmarks = C.condBenchmarks gpd ++ [(componentName name, converted)] }+  where+    componentName = C.mkUnqualComponentName . T.unpack+    library name bi = do+      raw <- fields spec (C.libraryFieldGrammar name) (A.extraFields bi)+      info <- convertBuildInfo (C.libBuildInfo raw) bi+      exposed <- traverse atom (A.exposedModules bi)+      pure raw { C.libBuildInfo = info, C.exposedModules = exposed }+    executable name bi = do+      raw <- fields spec (C.executableFieldGrammar name) (A.extraFields bi)+      info <- convertBuildInfo (C.buildInfo raw) bi+      pure raw { C.buildInfo = info, C.modulePath = path (fromMaybe "" (A.mainIs bi)) }+    foreignLibrary name bi = do+      raw <- fields spec (C.foreignLibFieldGrammar name) (A.extraFields bi)+      info <- convertBuildInfo (C.foreignLibBuildInfo raw) bi+      pure raw { C.foreignLibBuildInfo = info }+    testSuite bi = do+      raw <- fields spec C.testSuiteFieldGrammar (A.extraFields bi)+      info <- convertBuildInfo (C._testStanzaBuildInfo raw) bi+      result (C.validateTestSuite spec C.zeroPos raw+        { C._testStanzaBuildInfo = info, C._testStanzaMainIs = path <$> A.mainIs bi })+    benchmark bi = do+      raw <- fields spec C.benchmarkFieldGrammar (A.extraFields bi)+      info <- convertBuildInfo (C._benchmarkStanzaBuildInfo raw) bi+      result (C.validateBenchmark spec C.zeroPos raw+        { C._benchmarkStanzaBuildInfo = info, C._benchmarkStanzaMainIs = path <$> A.mainIs bi })+    result = either (Left . show) Right . snd . runResult

@@ -0,0 +1,63 @@+module Compliance.Compare+  ( Outcome (..), Comparison (..), compareBytes, comparePackage, outcomeName ) where++import qualified Data.ByteString as BS+import qualified Aihc.Cabal as A+import Compliance.Adapter (runResult, toCabal)+import qualified Distribution.PackageDescription as C+import qualified Distribution.PackageDescription.Parsec as C++data Outcome = Match | Mismatch | ParserError | ReferenceError | BothRejected | ConversionError+  deriving (Eq, Ord, Show, Enum, Bounded)++data Comparison = Comparison+  { outcome :: Outcome+  , parserAccepted :: Bool+  , referenceAccepted :: Bool+  , parserWarnings :: Int+  , referenceWarnings :: Int+  , detail :: String+  } deriving (Eq, Show)++outcomeName :: Outcome -> String+outcomeName value = case value of+  Match -> "match"+  Mismatch -> "mismatch"+  ParserError -> "parser_error"+  ReferenceError -> "reference_error"+  BothRejected -> "both_rejected"+  ConversionError -> "conversion_error"++compareBytes :: BS.ByteString -> Comparison+compareBytes bytes = case (A.parseValue ours, reference) of+  (Left errors, Left refErrors) -> report BothRejected False False (show errors ++ "\n" ++ show refErrors)+  (Left errors, Right _) -> report ParserError False True (show errors)+  (Right _, Left errors) -> report ReferenceError True False (show errors)+  (Right pkg, Right ref) -> let (status, message) = comparePackage pkg ref+                          in report status True True message+  where+    ours = A.parsePackage bytes+    (warnings, reference) = runResult (C.parseGenericPackageDescription bytes)+    report status accepted refAccepted message = Comparison status accepted refAccepted+      (length (A.parseWarnings ours)) (length warnings) message++comparePackage :: A.Package -> C.GenericPackageDescription -> (Outcome, String)+comparePackage pkg reference = case toCabal pkg of+  Left errors -> (ConversionError, errors)+  Right converted+    | converted == reference -> (Match, "")+    | otherwise -> (Mismatch, "Different fields: " ++ show (differences converted reference))++-- These labels explain failures. Equality always uses the complete value.+differences :: C.GenericPackageDescription -> C.GenericPackageDescription -> [String]+differences a b = [name | (name, different) <-+  [ ("packageDescription", C.packageDescription a /= C.packageDescription b)+  , ("gpdScannedVersion", C.gpdScannedVersion a /= C.gpdScannedVersion b)+  , ("genPackageFlags", C.genPackageFlags a /= C.genPackageFlags b)+  , ("condLibrary", C.condLibrary a /= C.condLibrary b)+  , ("condSubLibraries", C.condSubLibraries a /= C.condSubLibraries b)+  , ("condForeignLibs", C.condForeignLibs a /= C.condForeignLibs b)+  , ("condExecutables", C.condExecutables a /= C.condExecutables b)+  , ("condTestSuites", C.condTestSuites a /= C.condTestSuites b)+  , ("condBenchmarks", C.condBenchmarks a /= C.condBenchmarks b)+  ], different]

@@ -0,0 +1,182 @@+{-# LANGUAGE OverloadedStrings #-}+module Compliance.Tests (testCompliance) where++import Control.Monad (forM_, unless)+import qualified Data.ByteString as BS+import qualified Data.ByteString.Char8 as BSC+import qualified Data.Map.Strict as Map+import Data.Text (Text)+import qualified Aihc.Cabal as A+import Compliance.Adapter (runResult, toCabal)+import Compliance.Compare+import qualified Distribution.PackageDescription.Parsec as C++assert :: String -> Bool -> IO ()+assert label success = unless success (fail label)++header :: BS.ByteString+header = "cabal-version: 3.0\nname: sample\nversion: 1.0\n"++value :: Text -> A.FieldValue+value text = A.FieldValue (A.Position 1 1) [A.FieldLine (A.Position 1 1) text]++testCompliance :: IO ()+testCompliance = do+  forM_ ["1.0", "1.2", "1.4", "1.6", "1.8"] $ \spec ->+    forM_ ["", ">="] $ \prefix -> do+      let bytes = "cabal-version: " <> prefix <> spec+            <> "\nname: sample\nversion: 1\nbuild-type: Simple\nlibrary\n  exposed-modules: Sample\n  build-depends: base >=3 && <5\n"+      assert ("Compare older format " ++ BSC.unpack (prefix <> spec))+        (outcome (compareBytes bytes) == Match)+  forM_+    [ "synopsis: Sample text  \nauthor: A. Person \nhomepage: https://example.com/ \ndescription: First line  \n  Second line \nlibrary  \n  exposed-modules: Sample\n"+    , "library\n  exposed-modules: Sample\n  build-depends: base >=4 && <5\n"+    , "synopsis: Sample text \r\n  \r\nlibrary \r\n  -- A comment\r\n  exposed-modules: Sample \r\n"+    , "library\n"+    , "library\n  -- No fields\n"+    , "flag fast\nlibrary\n  if flag(fast)\n  else\n    cpp-options: -DSLOW\n"+    , "library\n  if True\n    cpp-options: -DFAST\n  else\n"+    , "library\n  if True\n  else\n  other-modules: Sample\n"+    , "library\n  if True\n    if False\n    else\n  else\n    cpp-options: -DSLOW\n"+    , "common shared\nlibrary\n  import: shared\n"+    , "library internal\nlibrary\nexecutable tool\n  main-is: Main.hs\n"+    , "executable tool\n"+    , "flag fast\n  default: False\nlibrary\n  if flag(fast)\n    cpp-options: -DFAST\n  else\n    buildable: False\n"+    , "common shared\n  hs-source-dirs: src\n  ghc-options: -Wall\nlibrary\n  import: shared\n"+    , "library internal\n  exposed-modules: Internal\nexecutable tool\n  main-is: Main.hs\n  build-depends: sample:internal\n"+    , "test-suite tests\n  type: exitcode-stdio-1.0\n  main-is: Test.hs\nbenchmark bench\n  type: exitcode-stdio-1.0\n  main-is: Bench.hs\n"+    , "foreign-library native\n  type: native-shared\n  options: standalone\n  c-sources: native.c\n"+    , "synopsis: A sample\nauthor: A. Person\nlibrary\n  extra-libraries: z\n  x-example: retained\n"+    , "source-repository head\n  type: git\n  location: https://example.com/sample\nlibrary\n  buildable: True\n"+    , "source-repository head\n  type: cvs\n  location: example.com:/source\n  module: sample\n  branch: main\nsource-repository this\n  type: git\n  location: https://example.com/sample\n  tag: v1.0\n  subdir: \"source files\"\nsource-repository head\n  type: darcs\n  location: https://example.com/mirror\n"+    , "source-repository head\n  type: hg\n  location: https://example.com/first\n  location: https://example.com/second\n  x-note: first\n    second\n"+    , "source-repository future\n  type: future\n"+    , "source-repository HEAD\n  type: GIT\n  location: https://example.com/sample\n"+    , "source-repository head\n  type: git\n  location: https://example.com/sample\n  subdir:\n"+    , "flag fast\n  description: Use fast code\nlibrary\n  buildable: True\n"+    , "flag fast\n  description: First line\n    second line\n    .\n    Last line\n  default: False\n  manual: True\n"+    , "flag fast\n  description:\nflag slow\n  description: \"Use slow code\"\n"+    , "description:\n  First line\n  Second line\nflag fast\n  description:\n    First line\n    Second line\n"+    , "description: First line\n\n    Indented line\n  .\n  Last line\nlibrary\n"+    , "build-type: Custom\ncustom-setup\n  setup-depends: base, Cabal\nlibrary\n  buildable: True\n"+    , "library { exposed-modules: Sample }\n"+    , "library\n  {\n    exposed-modules: Sample\n  }\n  if os(linux) {\n    cpp-options: -DLINUX\n  } else {\n    cpp-options: -DOTHER\n  }\n"+    , "library\n\tbuildable: True\n\texposed-modules: Sample\n"+    , "library\n    buildable: True\n  other-modules: Sample\n"+    , "Synopsis  : Text\nlibrary\n  Default-Language : Haskell2010\n"+    , "library\n  else\n    buildable: False\n"+    , "library\n  other-modules: Sample\n  import: missing\n"+    , "unknown-section\n  field: value\nlibrary\n"+    , "library\n  build-depends: base, base >=4\n  hs-source-dirs: src src\n"+    , "common one\n  build-depends: base\n  hs-source-dirs: src\n  frameworks: A\nlibrary\n  import: one\n  build-depends: base\n  hs-source-dirs: src\n  frameworks: A\n"+    , "common one\n  exposed-modules: Lost\n  visibility: public\n  x-a: 1\nlibrary\n  import: one\n  x-b: 2\n  exposed-modules: Sample\n"+    , "library\n  x-b: 2\n  x-a: 1\n  x-b: 3\n"+    , "library\n  mixins: base hiding (Prelude), containers (Data.Map as Map) requires (Sig as Impl)\n"+    , "library\n  default-language: Haskell98\n  default-language: Haskell2010\n  buildable: False\n  buildable: True\n"+    , "library\n  build-depends:\n    , base\n    , containers\n  other-modules:\n    , A\n    , B\n"+    , "flag Fast\n  default: false\nlibrary\n  if flag(FAST) || !impl(ghc >= 9.0) && os(Linux)\n    buildable: False\n  if impl(ghc == 9.*) || impl(ghc >= 7 && < 8) || true\n    buildable: True\n"+    , "library\n  if arch(x86_64)\n    buildable: False\n  elif os(windows)\n    buildable: False\n  else\n    buildable: True\n"+    , "library\r  exposed-modules: Sample\r  other-modules: Other\r"+    , "library\n  -- comment\n  exposed-modules:\n    Sample\n    -- comment\n\n    Other\n"+    , "library\n  build-depends: base >=4 && <5 || ==3.* , text ^>=2.0\n"+    ] $ \body -> do+      let result = compareBytes (header <> body)+      assert ("Expected equal structures: " ++ show result ++ "\n" ++ BSC.unpack body) (outcome result == Match)+  forM_ ["1.10", "2.0"] $ \spec ->+    forM_+      [ "  extensions: CPP, ForeignFunctionInterface\n"+      , "  extensions: CPP\n  default-extensions: OverloadedStrings\n"+      , "  default-extensions: CPP\n  extensions: CPP\n"+      , "  extensions: CPP\n  if os(linux)\n    extensions: ForeignFunctionInterface\n"+      ] $ \body -> do+        let bytes = "cabal-version: " <> spec <> "\nname: sample\nversion: 1\nbuild-type: Simple\nlibrary\n" <> body+        assert ("Keep extension field values: " ++ show (compareBytes bytes) ++ BSC.unpack bytes)+          (outcome (compareBytes bytes) == Match)+  forM_+    [ "^>=1", "^>=1.2.3", "^>={1.2,2.3,3.4}"+    , ">=1 && <2 && >1.1", "==1 || ==2 || ==3"+    , "(==1 || ==2) || ==3", "^>=1.2 && (<1.3 || ==2)"+    ] $ \range -> do+      let bytes = header <> "library\n  build-depends: base " <> range <> "\n"+      assert ("Keep version range structure: " ++ BSC.unpack range)+        (outcome (compareBytes bytes) == Match)+  let extensionBytes = "cabal-version: 2.2\nname: sample\nversion: 1\nbuild-type: Simple\ncommon shared\n  extensions: CPP\nlibrary\n  import: shared\n  default-extensions: OverloadedStrings\n"+  extensionPackage <- either (fail . show) pure (A.parseValue (A.parsePackage extensionBytes))+  extensionReference <- either (fail . show) pure+    (snd (runResult (C.parseGenericPackageDescription extensionBytes)))+  assert "Convert imported older extensions"+    (fst (comparePackage extensionPackage extensionReference) == Match)+  let changedExtensions = extensionPackage { A.packageComponents =+        [component { A.componentData = tree { A.unconditional =+            (A.unconditional tree) { A.legacyExtensions = ["BangPatterns"] } } }+        | component <- A.packageComponents extensionPackage, let tree = A.componentData component] }+  assert "Use older extensions from the AST"+    (fst (comparePackage changedExtensions extensionReference) == Mismatch)+  forM_ ["==1 || ==2 || ==3", ">=1 && <3 && >1.1", "(==1 || ==2) || ==3"] $ \range -> do+    let bytes = header <> "library\n  if impl(ghc " <> range <> ")\n    buildable: False\n"+    assert "Keep compiler range structure" (outcome (compareBytes bytes) == Match)+  let toolBytes = header <> "library\n  build-tool-depends: alex:alex ^>=3.2.4\n  if impl(ghc ^>=9.2)\n    buildable: False\n"+  assert "Keep tool and compiler major bounds" (outcome (compareBytes toolBytes) == Match)+  forM_+    [ (">=1.10", "name: old\nversion: 1\nexposed-modules: Old\nbuild-depends: base\nexecutable: tool\nmain-is: Main.hs\n")+    , (">=1.10", "name: old\nversion: 1\nbuild-type: Default\nlibrary\n  cxx-sources: a.cpp\n  autogen-modules: A\n  default-language: Haskell2010\n")+    , (">=1.10", "name: old\nversion: 1\nlibrary\n  build-depends: sub\n  mixins: sub\nlibrary sub\n")+    , (">=1.10", "name: old\nversion: 1\nlibrary\n  if os(linux)\n    buildable: False\n  elif os(osx)\n    buildable: False\n")+    , (">=1.2", "name: old\nversion: 1\ndescription: First\n  .\n  Second\nlibrary\n  default-language: Haskell2010\n")+    , ("3.0", "name: old\nversion: 1\nlibrary\n  build-depends: sub, sub:{sub, other}\n  mixins: sub\nlibrary sub\nlibrary other\n")+    , ("2.2", "name: old\nversion: 1\ncommon one\n  build-depends: base\nlibrary\n  import: one\n  if os(linux)\n    import: one\n")+    , (">=0.9", "name: old\nversion: 1\n")+    ] $ \(spec, body) -> do+      let bytes = "cabal-version: " <> spec <> "\n" <> body+          result = compareBytes bytes+      assert ("Expected equal structures for an older format: " ++ show result ++ "\n" ++ BSC.unpack bytes) (outcome result == Match)+  let setupBytes = header <> "build-type: Custom\ncustom-setup\n  setup-depends: base, Cabal\nlibrary\n  buildable: True\n"+  setupPackage <- either (fail . show) pure (A.parseValue (A.parsePackage setupBytes))+  setupReference <- either (fail . show) pure (snd (runResult (C.parseGenericPackageDescription setupBytes)))+  assert "Lost data must fail equality"+    (fst (comparePackage setupPackage { A.packageSetupDependencies = Nothing } setupReference) == Mismatch)+  assert "Both parsers reject invalid input" (outcome (compareBytes "not a package") == BothRejected)+  assert "Count a reference parse error" (outcome (compareBytes (header <> "test-suite bad\n  type: exitcode-stdio-1.0\n")) == ReferenceError)+  let bytes = header <> "library\n  exposed-modules: Sample\n"+  pkg <- either (fail . show) pure (A.parseValue (A.parsePackage bytes))+  ref <- either (fail . show) pure (snd (runResult (C.parseGenericPackageDescription bytes)))+  let changed = pkg { A.packageName = "changed" }+  assert "Use the typed AST instead of the original name field" (fst (comparePackage changed ref) == Mismatch)+  let oldSpelling = pkg { A.packageFields = Map.insert "version" [value "1.00"] (A.packageFields pkg) }+  assert "Convert typed versions without reading the old spelling" (fst (comparePackage oldSpelling ref) == Match)+  let changedModule = pkg { A.packageComponents =+        [A.Component (A.Library A.MainLibrary) (A.Conditional+          (A.emptyBuildInfo { A.exposedModules = ["Changed"] }) [])] }+  assert "Compare component fields" (fst (comparePackage changedModule ref) == Mismatch)+  let invalid = pkg { A.packageComponents =+        [A.Component (A.Library A.MainLibrary) (A.Conditional+          (A.emptyBuildInfo { A.defaultLanguage = Just "invalid language" }) [])] }+  assert "Count conversion errors" (fst (comparePackage invalid ref) == ConversionError)+  let metadata = pkg { A.packageFields = Map.insert "synopsis" [value "Changed"] (A.packageFields pkg) }+  assert "Convert retained metadata" (fst (comparePackage metadata ref) == Mismatch)+  let repositoryBytes = header <> "source-repository head\n  type: git\n  location: https://example.com/sample\n"+  repositoryPackage <- either (fail . show) pure (A.parseValue (A.parsePackage repositoryBytes))+  repositoryReference <- either (fail . show) pure+    (snd (runResult (C.parseGenericPackageDescription repositoryBytes)))+  let changedRepository = repositoryPackage { A.packageSourceRepositories =+        [A.SourceRepository "this" (Map.fromList [("type", [value "git"]), ("tag", [value "v1.0"])])] }+  assert "Compare repository data"+    (fst (comparePackage changedRepository repositoryReference) == Mismatch)+  let removedRepository = repositoryPackage { A.packageSourceRepositories = [] }+  assert "Detect a missing repository"+    (fst (comparePackage removedRepository repositoryReference) == Mismatch)+  converted <- either fail pure (toCabal pkg)+  assert "Full Cabal equality" (converted == ref)+  forM_ ["1.10", "2.0", "3.0"] $ \spec -> do+    let flagBytes = "cabal-version: " <> spec <> "\nname: sample\nversion: 1\nbuild-type: Simple\nflag fast\n  description: First line\n    second line\n    .\n    Last line\n  default: False\n  manual: True\n"+    flagPackage <- either (fail . show) pure (A.parseValue (A.parsePackage flagBytes))+    flagReference <- either (fail . show) pure+      (snd (runResult (C.parseGenericPackageDescription flagBytes)))+    let expected = if spec == "3.0" then "First line\nsecond line\n.\nLast line" else "First line\nsecond line\n\nLast line"+    assert "Keep flag description text"+      (A.packageFlags flagPackage == [A.Flag "fast" False True expected])+    assert "Compare flag descriptions" (fst (comparePackage flagPackage flagReference) == Match)+    let changedFlag = flagPackage { A.packageFlags =+          [f { A.flagDescription = "Changed" } | f <- A.packageFlags flagPackage] }+    assert "Use flag descriptions from the AST"+      (fst (comparePackage changedFlag flagReference) == Mismatch)

@@ -0,0 +1,114 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE OverloadedStrings #-}+module Main (main) where++import qualified Codec.Archive.Tar as Tar+import Control.Exception (AsyncException, SomeException, evaluate, fromException, tryJust)+import Control.Monad (unless, when)+import Data.Aeson (Value, encode, object, (.=))+import qualified Data.ByteString as BS+import qualified Data.ByteString.Lazy as LBS+import qualified Data.Map.Strict as Map+import Data.List (isSuffixOf)+import System.Directory (createDirectory)+import System.Environment (getArgs)+import System.FilePath ((</>))+import System.IO (Handle, IOMode (..), hPutStrLn, stderr, withBinaryFile)+import Compliance.Compare+import Compliance.Tests (testCompliance)++data Counts = Counts+  { total :: !Int+  , accepted :: !Int+  , refAccepted :: !Int+  , warned :: !Int+  , refWarned :: !Int+  , outcomes :: !(Map.Map String Int)+  }++emptyCounts :: Counts+emptyCounts = Counts 0 0 0 0 0 (Map.fromList+  ([(outcomeName status, 0) | status <- [minBound .. maxBound]] ++ [("exception", 0)]))++summary :: Counts -> Value+summary counts = object+  [ "reference" .= ("Cabal-syntax" :: String)+  , "reference_version" .= (VERSION_Cabal_syntax :: String)+  , "total" .= total counts+  , "parser_accepted" .= accepted counts+  , "reference_accepted" .= refAccepted counts+  , "parser_with_warnings" .= warned counts+  , "reference_with_warnings" .= refWarned counts+  , "outcomes" .= outcomes counts+  ]++record :: Handle -> Value -> IO ()+record handle value = LBS.hPut handle (encode value <> "\n")++classify :: BS.ByteString -> IO (Either SomeException Comparison)+classify bytes = tryJust synchronous $ do+  let comparison = compareBytes bytes+  _ <- evaluate (length (show comparison))+  pure comparison+  where+    synchronous err = case fromException err :: Maybe AsyncException of+      Just _ -> Nothing+      Nothing -> Just err++main :: IO ()+main = do+  args <- getArgs+  case args of+    [] -> testCompliance+    ["--file", path] -> do+      result <- BS.readFile path >>= classify+      LBS.putStr (encode (case result of+        Left err -> object ["status" .= ("exception" :: String), "detail" .= show err]+        Right comparison -> comparisonJSON comparison) <> "\n")+    [index, destination] -> do+      -- Refuse to overwrite an earlier report.+      createDirectory destination+      counts <- withBinaryFile index ReadMode $ \source ->+        withBinaryFile (destination </> "failures.jsonl") WriteMode $ \report -> do+          bytes <- LBS.hGetContents source+          walk report Map.empty emptyCounts (Tar.read bytes)+      unless (total counts > 0) (fail "The index has no Cabal files")+      LBS.writeFile (destination </> "summary.json") (encode (summary counts) <> "\n")+      LBS.putStr (encode (summary counts) <> "\n")+    _ -> fail "Use: hackage-compliance INDEX.tar REPORT-DIRECTORY, or --file FILE.cabal"++comparisonJSON :: Comparison -> Value+comparisonJSON result = object+  [ "status" .= outcomeName (outcome result)+  , "parser_accepted" .= parserAccepted result+  , "reference_accepted" .= referenceAccepted result+  , "parser_warnings" .= parserWarnings result+  , "reference_warnings" .= referenceWarnings result+  , "detail" .= take 2000 (detail result)+  ]++walk :: Handle -> Map.Map FilePath Int -> Counts -> Tar.Entries Tar.FormatError -> IO Counts+walk _ _ counts Tar.Done = pure counts+walk _ _ _ (Tar.Fail err) = fail (show err)+walk report revisions counts (Tar.Next entry remaining)+  | not (".cabal" `isSuffixOf` path) = walk report revisions counts remaining+  | otherwise = case Tar.entryContent entry of+      Tar.NormalFile bytes _ -> do+        let revision = Map.findWithDefault 0 path revisions+            revisions' = Map.insert path (revision + 1) revisions+        result <- classify (LBS.toStrict bytes)+        let (status, ours, reference, oursWarnings, refWarningsCount, details) = case result of+              Left err -> ("exception", False, False, 0, 0, object ["detail" .= take 2000 (show err)])+              Right comparison -> (outcomeName (outcome comparison), parserAccepted comparison,+                referenceAccepted comparison, parserWarnings comparison, referenceWarnings comparison,+                comparisonJSON comparison)+            counts' = Counts (total counts + 1)+              (accepted counts + fromEnum ours) (refAccepted counts + fromEnum reference)+              (warned counts + fromEnum (oursWarnings > 0)) (refWarned counts + fromEnum (refWarningsCount > 0))+              (Map.insertWith (+) status 1 (outcomes counts))+        when (status /= "match") $ record report $ object+          [ "path" .= path, "revision" .= revision, "status" .= status, "result" .= details ]+        when (total counts' `mod` 10000 == 0) (hPutStrLn stderr ("Compared " ++ show (total counts') ++ " files"))+        walk report revisions' counts' remaining+      _ -> fail ("Invalid Cabal entry: " ++ path)+  where path = Tar.entryPath entry

@@ -0,0 +1,486 @@+{-# LANGUAGE OverloadedStrings #-}+module Main (main) where++import Control.Monad (forM_, unless)+import qualified Data.ByteString as BS+import qualified Data.ByteString.Char8 as BSC+import Data.List.NonEmpty (NonEmpty (..))+import qualified Data.List.NonEmpty as NE+import qualified Data.Map.Strict as Map+import Data.Text (Text)+import qualified Data.Text as T+import qualified Data.Text.Encoding as TE+import Aihc.Cabal+import qualified Distribution.Fields.ParseResult as C+import qualified Distribution.PackageDescription as C+import qualified Distribution.PackageDescription.Parsec as C+import qualified Distribution.Parsec as C+import qualified Distribution.Pretty as C+import qualified Distribution.Types.Version as C+import qualified Distribution.Types.VersionRange as C+import qualified Distribution.Utils.Path as C++assert :: (Eq a, Show a) => String -> a -> a -> IO ()+assert label expected actual = unless (expected == actual)+  (fail (label ++ "\nExpected: " ++ show expected ++ "\nActual: " ++ show actual))++right :: Show e => Either e a -> IO a+right = either (fail . show) pure++-- | Run a Cabal-syntax parser without a source name. The results keep the+-- error and warning format of Cabal-syntax 3.12.+runResult :: C.ParseResult () a+  -> ([C.PWarning], Either (Maybe C.Version, NonEmpty C.PError) a)+runResult result = case C.runParseResult result of+  (warnings, outcome) -> (map C.pwarning warnings, either (Left . fmap (fmap C.perror)) Right outcome)++parse :: BSC.ByteString -> IO Package+parse = right . parseValue . parsePackage++version :: Text -> Version+version = either (error . T.unpack) id . parseVersion++environment :: Environment+environment = Environment "linux" "x86_64" "ghc" (version "9.12.2")++resolve :: FlagAssignment -> Package -> IO [Component BuildInfo]+resolve flags pkg = pure (resolvedComponents (resolvePackage environment flags pkg))++header :: [String]+header = ["cabal-version: 3.0", "name: sample", "version: 1.2.3"]++fixture :: BSC.ByteString+fixture = BSC.unlines (map BSC.pack (header +++  [ "flag fast", "  default: True", "  manual: False"+  , "common shared", "  hs-source-dirs: src", "  default-language: Haskell2010"+  , "  build-depends: base >=4.16 && <5"+  , "  cpp-options: -DROOT"+  , "  if flag(fast)", "    cpp-options: -DFAST"+  , "common native", "  import: shared", "  c-sources: cbits/a.c"+  , "  cxx-sources: cbits/b.cpp", "  include-dirs: include", "  install-includes: api.h"+  , "  autogen-includes: config.h", "  cc-options: -std=c11", "  cxx-options: -std=c++17"+  , "library", "  import: native", "  exposed-modules: Sample"+  , "  other-modules: Sample.Internal", "  autogen-modules: Paths_sample"+  , "  default-extensions: CPP, OverloadedStrings"+  , "  ghc-options: -F -pgmFtrhsx -optP-DPAIR=1,2"+  , "  x-aihc-lir-sources: lir/a.lir lir/b.lir"+  , "  build-depends: sample:internal, containers ^>=0.7"+  , "  build-tool-depends: alex:alex >=3.2"+  , "  if os(linux) && impl(ghc >=9.10) && flag(fast)"+  , "    exposed-modules: Sample.Fast", "    cpp-options: -DSELECTED", "    hs-source-dirs: src", "    other-modules: Sample.Internal", "    default-extensions: CPP"+  , "    if arch(x86_64)", "      other-modules: Sample.X86"+  , "  else", "    exposed-modules: Sample.Slow", "    buildable: False"+  , "library internal", "  exposed-modules: Internal", "  build-depends: base"+  , "executable sample-tool", "  main-is: Main.hs", "  build-depends: internal"+  , "test-suite tests", "  type: exitcode-stdio-1.0", "  main-is: Tests.hs"+  , "  build-depends: sample, base"+  , "benchmark bench", "  type: exitcode-stdio-1.0", "  main-is: Bench.hs"+  , "foreign-library native-lib", "  type: native-shared", "  build-tool-depends: hsc2hs:hsc2hs"+  ]))++main :: IO ()+main = do+  testVersions+  testPackage+  testConsumers+  testDefaults+  testEmptySections+  testLegacy+  testSourceRepositories+  testBuildInfo+  testConditionalSpelling+  testElif+  testImportCommas+  testInternalLibraryNames+  testRetainedFields+  testOlderToolDependencies+  testRepeatedPackageFields+  testNewFormatVersions+  testErrors+  putStrLn "All parser checks passed"++testVersions :: IO ()+testVersions = do+  forM_ ["0", "0.0", "1", "1.2", "1.2.0", "1.2.3", "1.3", "2", "2.0", "4.18", "9.12.2"] $ \v ->+    assert "Version round trip" (Right (version v)) (parseVersion (renderVersion (version v)))+  forM_ ["-any", "-none", "==1.2", "==1.2.*", ">=1.2 && <2", "^>=1.2.3", "^>=1", "^>=0.0.3", ">=1 && <3 && >1.2", "==1 || ==2 || ==3", "=={1.2,2.3}", "^>={1.2,2.3}", "<=1.2 || >2", "(>=1 && <2) || ==3"] $ \input -> do+    range <- right (parseVersionRange input)+    ref <- case input of+      "-any" -> pure C.anyVersion+      "-none" -> pure C.noVersion+      _ -> maybe (fail ("Reference range parse failed: " ++ T.unpack input)) pure (C.simpleParsec (T.unpack input) :: Maybe C.VersionRange)+    forM_ [[0], [0,0,3], [0,1], [1], [1,0], [1,1], [1,2], [1,2,0], [1,2,3], [1,2,4], [1,3], [2], [2,0], [3], [4,18]] $ \ns -> do+      v <- maybe (fail "Invalid test version") pure (mkVersion (map toInteger ns))+      assert ("Range membership: " ++ T.unpack input ++ " " ++ show ns)+        (C.withinRange (C.mkVersion ns) ref) (withinRange v range)+    parsed <- right (parseVersionRange (renderVersionRange range))+    assert "Range round trip" range parsed+  assert "Version ordering" True (version "1.2" < version "1.2.0")+  assert "Negative version" Nothing (mkVersion [-1])+  assert "Empty version" Nothing (mkVersion [])+  forM_ [(">=1.2 && <1.3 || ==2.0", ">=1.2 && <1.3 || ==2.0"), ("(>=1 && <2) || ==3", ">=1 && <2 || ==3"), ("^>=1.2 && (<1.3 || ==2)", "^>=1.2 && (<1.3 || ==2)"), ("(==1 || ==2) || ==3", "(==1 || ==2) || ==3"), ("(>=1 && <2) && >1.1", "(>=1 && <2) && >1.1"), ("-any", "-any"), ("-none", "<0")] $ \(input, expected) -> do+    range <- right (parseVersionRange input)+    assert ("Range rendering: " ++ T.unpack input) expected (renderVersionRange range)+  forM_ ["", "1.", "-1", "1..2", "1a", "1.2 trailing"] $ \input ->+    case parseVersion input of+      Left _ -> pure ()+      Right _ -> fail "Invalid version accepted"+  forM_ ["==", ">=1 trailing", "==1.*.*", "<1 &&", "1.2"] $ \input ->+    case parseVersionRange input of+      Left _ -> pure ()+      Right _ -> fail "Invalid range accepted"++testPackage :: IO ()+testPackage = do+  pkg <- parse fixture+  ref <- right (snd (runResult (C.parseGenericPackageDescription fixture)))+  assert "Package name" "sample" (packageName pkg)+  assert "No warnings for a file without patches" [] (parseWarnings (parsePackage fixture))+  assert "Component count" 6 (length (packageComponents pkg))+  assert "Flag declarations" [Flag "fast" True False ""] (packageFlags pkg)+  forM_ [True, False] $ \fast -> do+    cs <- resolve (Map.singleton "fast" fast) pkg+    bi <- case cs of Component (Library MainLibrary) b:_ -> pure b; _ -> fail "Missing library"+    tree <- maybe (fail "Missing reference library") pure (C.condLibrary ref)+    let selected = collect fast tree+        cbi = mconcat (map C.libBuildInfo selected)+    assert "Buildable" (Just (C.buildable cbi)) (buildable bi)+    assert "Source directories" (map C.getSymbolicPath (C.hsSourceDirs cbi)) (sourceDirs bi)+    assert "Exposed modules" (map (T.pack . C.prettyShow) (concatMap C.exposedModules selected)) (exposedModules bi)+    assert "Other modules" (map (T.pack . C.prettyShow) (C.otherModules cbi)) (otherModules bi)+    assert "Generated modules" (map (T.pack . C.prettyShow) (C.autogenModules cbi)) (autogenModules bi)+    assert "Language" (T.pack . C.prettyShow <$> C.defaultLanguage cbi) (defaultLanguage bi)+    assert "Extensions" (map (T.pack . C.prettyShow) (C.defaultExtensions cbi)) (extensions bi)+    assert "CPP options" (map T.pack (C.cppOptions cbi)) (cppOptions bi)+    assert "C sources" (map C.getSymbolicPath (C.cSources cbi)) (cSources bi)+    assert "C++ sources" (map C.getSymbolicPath (C.cxxSources cbi)) (cxxSources bi)+    assert "C options" (map T.pack (C.ccOptions cbi)) (ccOptions bi)+    assert "C++ options" (map T.pack (C.cxxOptions cbi)) (cxxOptions bi)+    assert "Include directories" (map C.getSymbolicPath (C.includeDirs cbi)) (includeDirs bi)+    assert "Public headers" (map C.getSymbolicPath (C.installIncludes cbi)) (installIncludes bi)+    assert "Generated headers" (map C.getSymbolicPath (C.autogenIncludes cbi)) (autogenIncludes bi)+    assert "Option commas" ["-F", "-pgmFtrhsx", "-optP-DPAIR=1,2"] (ghcOptions bi)+    assert "Custom fields" (Just ["lir/a.lir lir/b.lir"]) (map fieldText <$> Map.lookup "x-aihc-lir-sources" (extraFields bi))+    assert "Dependency names" ["base", "sample", "containers"] (map dependencyPackage (dependencies bi))+    assert "Named dependency" (NamedLibrary "internal" :| []) (dependencyLibraries (dependencies bi !! 1))+    assert "Build tools" ["alex"] (map toolName (buildTools bi))+    assert "Tool packages" [Just "alex"] (map toolPackage (buildTools bi))+    let exe = componentData (cs !! 2)+    assert "Legacy internal dependency" ["sample"] (map dependencyPackage (dependencies exe))+    assert "Legacy internal target" [NamedLibrary "internal" :| []] (map dependencyLibraries (dependencies exe))+  where+    collect fast (C.CondNode a bs) = a : concatMap branch bs+      where+        branch (C.CondBranch c t e) = if eval c then collect fast t else maybe [] (collect fast) e+        eval c = case c of+          C.Lit b -> b+          C.Var (C.PackageFlag _) -> fast+          C.Var (C.OS os) -> C.prettyShow os == "linux"+          C.Var (C.Arch arch) -> C.prettyShow arch == "x86_64"+          C.Var (C.Impl flavor range) -> C.prettyShow flavor == "ghc" && C.withinRange (C.mkVersion [9,12,2]) range+          C.CNot a' -> not (eval a')+          C.CAnd a' b -> eval a' && eval b+          C.COr a' b -> eval a' || eval b++testConsumers :: IO ()+testConsumers = forM_ ["aihc-hackage", "aihc-package-plan", "aihc-haddock"] $ \pkgName -> do+  input <- BSC.readFile ("test/fixtures/" ++ pkgName ++ ".cabal")+  pkg <- parse input+  ref <- right (snd (runResult (C.parseGenericPackageDescription input)))+  components <- resolve Map.empty pkg+  assert "Consumer package name" (T.pack pkgName) (packageName pkg)+  bi <- case components of+    Component (Library MainLibrary) b:_ -> pure b+    _ -> fail "Missing consumer library"+  library <- maybe (fail "Missing reference library") (pure . C.condTreeData) (C.condLibrary ref)+  let cbi = C.libBuildInfo library+  assert "Consumer modules" (map (T.pack . C.prettyShow) (C.exposedModules library)) (exposedModules bi)+  assert "Consumer source directories" (map C.getSymbolicPath (C.hsSourceDirs cbi)) (sourceDirs bi)+  assert "Consumer language" (T.pack . C.prettyShow <$> C.defaultLanguage cbi) (defaultLanguage bi)+  assert "Consumer dependency count" (length (C.targetBuildDepends cbi)) (length (dependencies bi))++testDefaults :: IO ()+testDefaults = do+  pkg <- parse (BSC.unlines (map BSC.pack (header +++    ["flag chosen", "  default: False", "library", "  if !flag(chosen)", "    hs-source-dirs: generated", "    default-language: Haskell2010", "  else", "    buildable: False"])))+  [Component _ bi] <- resolve Map.empty pkg+  assert "Branch directory excludes default" ["generated"] (sourceDirs bi)+  assert "Branch language" (Just "Haskell2010") (defaultLanguage bi)+  assert "Buildable default" (Just True) (buildable bi)+  [Component _ other] <- resolve (Map.singleton "chosen" True) pkg+  assert "Default directory" ["."] (sourceDirs other)+  assert "Absent language stays absent" Nothing (defaultLanguage other)+  assert "Buildable branch" (Just False) (buildable other)+  assert "Unknown override has no effect" (Map.singleton "chosen" False)+    (resolvedFlags (resolvePackage environment (Map.singleton "missing" True) pkg))+  quoted <- parse (BSC.unlines (map BSC.pack (header ++ ["library", "  hs-source-dirs: \"source files\"", "  cpp-options: \"-DNAME=hello world\"", "  buildable: False", "  if True", "    buildable: True"])))+  [Component _ q] <- resolve Map.empty quoted+  assert "Quoted path" ["source files"] (sourceDirs q)+  assert "Quoted option" ["-DNAME=hello world"] (cppOptions q)+  assert "Buildable conjunction" (Just False) (buildable q)++testEmptySections :: IO ()+testEmptySections = do+  pkg <- parse "cabal-version: 3.0\nname: sample\nversion: 1\nflag fast\ncommon shared\nlibrary\n  import: shared\n  if flag(fast)\n  else\n    cpp-options: -DSLOW\n  ghc-options: -Wall\nexecutable tool\n"+  assert "Empty flag defaults" [Flag "fast" True False ""] (packageFlags pkg)+  assert "Keep empty sections and branch boundaries"+    [ Component (Library MainLibrary) (Conditional+        (emptyBuildInfo { ghcOptions = ["-Wall"] })+        [Branch (FlagValue "fast") (Conditional emptyBuildInfo [])+          (Just (Conditional (emptyBuildInfo { cppOptions = ["-DSLOW"] }) []))])+    , Component (Executable "tool") (Conditional emptyBuildInfo [])+    ] (packageComponents pkg)+  forM_ [True, False] $ \fast -> do+    components <- resolve (Map.singleton "fast" fast) pkg+    info <- case components of+      Component (Library MainLibrary) bi : _ -> pure bi+      _ -> fail "Missing library"+    assert "Select an empty branch" (if fast then [] else ["-DSLOW"]) (cppOptions info)+    assert "Keep fields after an empty branch" ["-Wall"] (ghcOptions info)++testLegacy :: IO ()+testLegacy = do+  forM_ ["1.0", "1.2", "1.4", "1.6", "1.8"] $ \spec -> do+    older <- parse ("cabal-version: >=" <> TE.encodeUtf8 spec+      <> "\nname: sample\nversion: 1\nlibrary\n  exposed-modules: Sample\n")+    assert "Keep the older format version" (version spec) (cabalVersion older)+    assert "Keep the older library modules" [["Sample"]]+      (map (exposedModules . unconditional . componentData) (packageComponents older))+  let input = "cabal-version: >=1.10\nname: legacy\nversion: 1\nlibrary\n  extensions: CPP\n  build-tools: happy >=1.20\n"+  pkg <- parse input+  _ <- right (snd (runResult (C.parseGenericPackageDescription input)))+  [Component _ bi] <- resolve Map.empty pkg+  assert "Legacy extensions" ["CPP"] (legacyExtensions bi)+  assert "Default extension field" [] (extensions bi)+  let extensionInput = "cabal-version: 2.2\nname: sample\nversion: 1\ncommon shared\n  extensions: CPP\n  default-extensions: OverloadedStrings\nlibrary\n  import: shared\n  if os(linux)\n    extensions: ForeignFunctionInterface\n    default-extensions: BangPatterns\n"+  extensionPackage <- parse extensionInput+  [Component _ extensionInfo] <- resolve Map.empty extensionPackage+  assert "Merge older extensions" ["CPP", "ForeignFunctionInterface"] (legacyExtensions extensionInfo)+  assert "Merge default extensions" ["OverloadedStrings", "BangPatterns"] (extensions extensionInfo)+  assert "Legacy tool name" ["happy"] (map toolName (buildTools bi))+  assert "Legacy tool package" [Nothing] (map toolPackage (buildTools bi))+  let setInput = BSC.unlines (map BSC.pack (header +++        ["library", "  build-depends: , base:{base} >=4, sample:{one,two} ^>={1.2,2.3}"]))+  sets <- parse setInput+  _ <- right (snd (runResult (C.parseGenericPackageDescription setInput)))+  [Component _ setInfo] <- resolve Map.empty sets+  assert "Main library target" (MainLibrary :| []) (dependencyLibraries (dependencies setInfo !! 0))+  assert "Library target set" (NamedLibrary "one" :| [NamedLibrary "two"])+    (dependencyLibraries (dependencies setInfo !! 1))++testSourceRepositories :: IO ()+testSourceRepositories = do+  let input = BSC.unlines (map BSC.pack (header +++        [ "source-repository head", "  type: git"+        , "  location: https://example.com/first", "  location: https://example.com/second"+        , "  x-note: first", "    second"+        , "library", "  exposed-modules: Sample"+        , "source-repository this", "  type: git", "  tag: v1.2.3"+        , "  subdir: \"source files\""+        , "source-repository head", "  type: darcs", "  location: https://example.com/third"+        ]))+  pkg <- parse input+  assert "Keep repository sections in source order"+    [ ("head", Map.fromList+        [ ("type", ["git"])+        , ("location", ["https://example.com/first", "https://example.com/second"])+        , ("x-note", ["first\nsecond"])+        ])+    , ("this", Map.fromList+        [("type", ["git"]), ("tag", ["v1.2.3"]), ("subdir", ["\"source files\""])])+    , ("head", Map.fromList+        [("type", ["darcs"]), ("location", ["https://example.com/third"])])+    ] [(k, Map.map (map fieldText) fs) | SourceRepository k fs <- packageSourceRepositories pkg]+  assert "Keep field positions"+    [Just [FieldValue (Position 8 3) [FieldLine (Position 8 11) "first", FieldLine (Position 9 5) "second"]]]+    (take 1 [Map.lookup "x-note" fs | SourceRepository _ fs <- packageSourceRepositories pkg])+  empty <- parse (BSC.unlines (map BSC.pack header))+  assert "Absent repositories" [] (packageSourceRepositories empty)++testBuildInfo :: IO ()+testBuildInfo = do+  let input = "cc-options: -DHOOKED\ncpp-options: -DHOOKED_HS\ninclude-dirs: generated\nc-sources: generated.c\nexecutable: sample-tool\ncpp-options: -DEXE\n"+  ours <- right (parseValue (parseHookedBuildInfo input))+  (lib, exes) <- right (snd (runResult (C.parseHookedBuildInfo input)))+  assert "Buildinfo C options" (map T.pack . C.ccOptions <$> lib) (ccOptions <$> hookedLibrary ours)+  assert "Buildinfo executable count" (length exes) (Map.size (hookedExecutables ours))+  assert "Buildinfo executable options" (Just ["-DEXE"]) (cppOptions <$> Map.lookup "sample-tool" (hookedExecutables ours))+  empty <- right (parseValue (parseHookedBuildInfo ""))+  assert "Empty buildinfo" (HookedBuildInfo Nothing Map.empty) empty++-- | Cabal does not make a difference between upper case and lower case+-- in section keywords. A parenthesis can follow the keyword directly.+testConditionalSpelling :: IO ()+testConditionalSpelling = do+  pkg <- parse (BSC.unlines (map BSC.pack (header +++    [ "flag fast", "  default: False", "library"+    , "  If flag(fast)", "    cpp-options: -DFAST"+    , "  Else", "    cpp-options: -DSLOW"+    , "  if(os(linux))", "    cpp-options: -DLINUX"+    ])))+  [Component _ bi] <- resolve Map.empty pkg+  assert "Keyword spelling" ["-DSLOW", "-DLINUX"] (cppOptions bi)+  [Component _ fast] <- resolve (Map.singleton "fast" True) pkg+  assert "Keyword spelling with a flag" ["-DFAST", "-DLINUX"] (cppOptions fast)++testElif :: IO ()+testElif = do+  let input = BSC.unlines (map BSC.pack (header +++        [ "library"+        , "  if arch(wasm32)", "    hs-source-dirs: wasm"+        , "  elif os(osx)", "    hs-source-dirs: darwin"+        , "  elif os(linux)", "    hs-source-dirs: linux"+        , "  else", "    hs-source-dirs: other"+        ]))+  pkg <- parse input+  _ <- right (snd (runResult (C.parseGenericPackageDescription input)))+  [Component _ bi] <- resolve Map.empty pkg+  assert "Select an elif branch" ["linux"] (sourceDirs bi)+  let at os arch = do+        let resolved = resolvePackage (Environment os arch "ghc" (version "9.12.2")) Map.empty pkg+        pure [sourceDirs b | Component _ b <- resolvedComponents resolved]+  darwin <- at "osx" "aarch64"+  assert "Select the first elif branch" [["darwin"]] darwin+  wasm <- at "wasi" "wasm32"+  assert "Select the if branch" [["wasm"]] wasm+  other <- at "windows" "x86_64"+  assert "Select the else branch" [["other"]] other+  -- Before cabal-version 2.2, Cabal ignores elif and gives a warning. It also+  -- ignores the else section after it, because no if section comes before it.+  older <- parse "cabal-version: 2.0\nname: sample\nversion: 1\nbuild-type: Simple\nlibrary\n  if os(osx)\n    cpp-options: -DOSX\n  elif os(linux)\n    cpp-options: -DLINUX\n  else\n    cpp-options: -DOTHER\n"+  [Component _ olderInfo] <- resolve Map.empty older+  assert "Ignore elif before 2.2" [] (cppOptions olderInfo)++testImportCommas :: IO ()+testImportCommas = do+  let input = BSC.unlines (map BSC.pack (header +++        [ "common one", "  cpp-options: -DONE", "common two", "  cpp-options: -DTWO"+        , "library", "  import:", "    , one", "    , two"+        ]))+  pkg <- parse input+  _ <- right (snd (runResult (C.parseGenericPackageDescription input)))+  [Component _ bi] <- resolve Map.empty pkg+  assert "Import list with leading commas" ["-DONE", "-DTWO"] (cppOptions bi)++-- | Before cabal-version 3.4, an internal library name hides a package+-- with the same name. From 3.4, a dependency name always identifies a package.+testInternalLibraryNames :: IO ()+testInternalLibraryNames = forM_ [("3.0", ("sample", NamedLibrary "mtl")), ("3.4", ("mtl", MainLibrary))] $ \(spec, expected) -> do+  let input = BSC.unlines (map BSC.pack+        [ "cabal-version: " ++ spec, "name: sample", "version: 1"+        , "library", "  build-depends: mtl", "library mtl", "  build-depends: base"+        ])+  pkg <- parse input+  ref <- right (snd (runResult (C.parseGenericPackageDescription input)))+  library <- maybe (fail "Missing reference library") (pure . C.libBuildInfo . C.condTreeData) (C.condLibrary ref)+  (Component _ bi : _) <- resolve Map.empty pkg+  assert ("Dependency name for " ++ spec) [expected]+    [(dependencyPackage d, NE.head (dependencyLibraries d)) | d <- dependencies bi]+  assert ("Reference dependency name for " ++ spec) [fst expected]+    [T.pack (C.prettyShow (C.depPkgName d)) | d <- C.targetBuildDepends library]++-- | The parser keeps fields that it does not interpret.+testRetainedFields :: IO ()+testRetainedFields = do+  pkg <- parse (BSC.unlines (map BSC.pack (header +++    [ "library", "  reexported-modules: Data.Other, Data.Alias as Alias"+    , "  mixins: base hiding (Prelude), containers (A as B) requires (C)", "  signatures: Hole"+    ])))+  [Component _ bi] <- resolve Map.empty pkg+  assert "Module reexports" (Just ["Data.Other, Data.Alias as Alias"]) (map fieldText <$> Map.lookup "reexported-modules" (extraFields bi))+  assert "Mixins"+    [ Mixin "base" MainLibrary (HidingRenaming ["Prelude"]) DefaultRenaming+    , Mixin "containers" MainLibrary (ModuleRenaming [("A", "B")]) (ModuleRenaming [("C", "C")]) ]+    (mixins bi)+  assert "Signatures" (Just ["Hole"]) (map fieldText <$> Map.lookup "signatures" (extraFields bi))++-- | Before cabal-version 2.0, Cabal keeps build-tool-depends and gives a warning.+testOlderToolDependencies :: IO ()+testOlderToolDependencies = do+  let input = "cabal-version: >=1.10\nname: sample\nversion: 1\nlibrary\n  build-tool-depends: hspec-discover:hspec-discover\n  build-tools: happy\n"+  pkg <- parse input+  ref <- right (snd (runResult (C.parseGenericPackageDescription input)))+  library <- maybe (fail "Missing reference library") (pure . C.libBuildInfo . C.condTreeData) (C.condLibrary ref)+  [Component _ bi] <- resolve Map.empty pkg+  assert "Reference keeps the field" 1 (length (C.buildToolDepends library))+  assert "Keep build-tool-depends after build-tools" [Nothing, Just "hspec-discover"] (map toolPackage (buildTools bi))++-- | Cabal accepts repeated package fields with a warning. For a field with+-- one value, the last value wins.+testRepeatedPackageFields :: IO ()+testRepeatedPackageFields = do+  pkg <- parse (BSC.unlines (map BSC.pack (header +++    ["extra-source-files: a.txt", "tested-with: GHC == 9.10", "extra-source-files: b.txt"])))+  assert "Keep each value in source order" (Just ["a.txt", "b.txt"]) (map fieldText <$> Map.lookup "extra-source-files" (packageFields pkg))+  described <- parse (BSC.unlines (map BSC.pack (header ++ ["synopsis: Sample text", "description: First line", "", "    Indented line", "  .", "  Last line"])))+  assert "Free text from 3.0" (Just "First line\n\n  Indented line\n.\nLast line") (packageFieldText described "description")+  assert "Free text field name case" (Just "Sample text") (packageFieldText described "Synopsis")+  assert "Absent free text" Nothing (packageFieldText described "author")+  older <- parse "cabal-version: >=1.10\nname: sample\nversion: 1\ndescription: First line\n  .\n  Last line\n"+  assert "Free text before 3.0" (Just "First line\n\nLast line") (packageFieldText older "description")+  renamed <- parse (BSC.unlines (map BSC.pack (header ++ ["name: other", "version: 2"])))+  assert "Last name wins" "other" (packageName renamed)+  assert "Last version wins" (version "2") (packageVersion renamed)+  forM_ ["cabal-version: 2.2", "version: 1..2"] $ \field ->+    case parseValue (parsePackage (BSC.unlines (map BSC.pack (header ++ [field])))) of+      Left _ -> pure ()+      Right _ -> fail ("Invalid repeated field accepted: " ++ field)++-- | Format versions 3.16 and 3.18, the build type rules of Cabal-syntax+-- 3.18, and absolute source directories.+testNewFormatVersions :: IO ()+testNewFormatVersions = do+  forM_+    [ ("3.16", "build-type: Simple", True)+    , ("3.18", "build-type: Simple", True)+    , ("3.16", "build-type: Make", True)+    , ("3.18", "build-type: Make", False)+    , ("3.12", "build-type: Hooks\ncustom-setup\n  setup-depends: base", False)+    , ("3.14", "build-type: Hooks\ncustom-setup\n  setup-depends: base", True)+    , ("3.18", "build-type: Hooks\ncustom-setup\n  setup-depends: base", True)+    , ("3.14", "build-type: Hooks", False)+    , ("3.18", "library\n  hs-source-dirs: /absolute", True)+    ] $ \(spec, body, accepted) -> do+      let input = BSC.pack ("cabal-version: " ++ spec ++ "\nname: sample\nversion: 1\n" ++ body ++ "\n")+          ours = either (const False) (const True) (parseValue (parsePackage input))+          reference = either (const False) (const True) (snd (runResult (C.parseGenericPackageDescription input)))+      assert ("Reference acceptance: " ++ spec ++ " " ++ body) accepted reference+      assert ("Acceptance: " ++ spec ++ " " ++ body) accepted ours+  pkg <- parse "cabal-version: 3.18\nname: sample\nversion: 1\n"+  assert "Newest format version" (version "3.18") (cabalVersion pkg)++testErrors :: IO ()+testErrors = do+  forM_+    [ ["library", "  build-tools: happy"]+    , ["library", "  if flag(missing)", "    buildable: False"]+    , ["library", "  import: missing"]+    , ["library", "  buildable: maybe"]+    , ["library", "  build-depends: base >="]+    , ["library", "  exposed-modules: lower"]+    , ["library { exposed-modules: Sample"]+    , ["common a", "  import: a", "library", "  import: a"]+    , ["library", "  buildable: True", "library", "  buildable: True"]+    , ["source-repository head", "  if True", "    type: git"]+    , ["library", "  if"]+    , ["library", "  if flag(missing)"]+    , ["library", "  if os(linux) &&", "    buildable: False"]+    , ["flag bad name"]+    , ["library", "  build-depends: base:"]+    ] $ \body -> reject (BSC.unlines (map BSC.pack (header ++ body)))+  reject "version: 1\n"+  reject "cabal-version: 99\nname: sample\nversion: 1\n"+  reject "cabal-version: 3.10\nname: sample\nversion: 1\n"+  reject "name: sample\nversion: 1\ncabal-version: 2.2\n"+  reject (BS.pack [255,254])+  let bad = parsePackage (BSC.unlines (map BSC.pack (header ++ ["library", "  buildable: invalid"])))+  case parseValue bad of+    Left d -> assert "Error source position" (Just (Position 5 3)) (diagnosticPosition d)+    Right _ -> fail "Invalid input accepted"+  case parseValue (parsePackage "version: 1\n") of+    Left d -> assert "Package check has no position" Nothing (diagnosticPosition d)+    Right _ -> fail "Invalid input accepted"+  where+    reject bytes = case parseValue (parsePackage bytes) of+      Left _ -> pure ()+      Right _ -> fail ("Invalid input accepted: " ++ BSC.unpack bytes)

@@ -0,0 +1,767 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RankNTypes #-}+-- | Make random package descriptions with Hedgehog. Write each description+-- with the Cabal-syntax pretty-printer. Then read the text with the parser+-- and with Cabal-syntax. The two results must be equal. The Cabal-syntax+-- result must also be equal to the random description, so that the test+-- finds data that the text does not keep.+--+-- The generator makes all values that the printer can write correctly.+-- A comment identifies each value that the generator does not make, and+-- gives the reason.+module Main (main) where++import Control.Monad (unless)+import Data.List (nub)+import Data.Maybe (fromMaybe)+import qualified Data.Text as T+import qualified Data.Text.Encoding as TE+import Hedgehog+import qualified Hedgehog.Gen as Gen+import qualified Hedgehog.Internal.Config as Config+import qualified Hedgehog.Internal.Property as Property+import qualified Hedgehog.Internal.Report as Report+import qualified Hedgehog.Internal.Runner as Runner+import qualified Hedgehog.Internal.Seed as Seed+import qualified Hedgehog.Range as Range+import System.Exit (exitFailure)+import qualified Aihc.Cabal as A+import Compliance.Adapter (runResult, toCabal)+import qualified Distribution.CabalSpecVersion as C+import qualified Distribution.Compat.NonEmptySet as NES+import qualified Distribution.Compiler as C+import qualified Distribution.License as L+import qualified Distribution.ModuleName as C+import qualified Distribution.PackageDescription as C+import qualified Distribution.PackageDescription.Parsec as C+import qualified Distribution.PackageDescription.PrettyPrint as C+import qualified Distribution.Parsec as C+import qualified Distribution.SPDX as SPDX+import qualified Distribution.System as C+import qualified Distribution.Types.Version as C+import qualified Distribution.Types.VersionRange as C+import qualified Distribution.Utils.Path as C+import qualified Distribution.Utils.ShortText as C+import qualified Language.Haskell.Extension as C++-- | The number of random packages in each test run.+testCount :: TestLimit+testCount = 2000++-- | A fixed seed makes each run test the same packages.+seed :: Seed.Seed+seed = Seed.from 20260928++main :: IO ()+main = do+  report <- Runner.checkReport (Property.propertyConfig prop) 0 seed (Property.propertyTest prop) (const (pure ()))+  output <- Report.renderResult Config.DisableColor (Just "pretty-printer round trip") report+  putStrLn output+  unless (Report.reportStatus report == Report.OK) exitFailure+  where+    prop = withTests testCount prop_roundTrip++prop_roundTrip :: Property+prop_roundTrip = property $ do+  gpd <- forAllWith C.showGenericPackageDescription genPackage+  let pd = C.packageDescription gpd+      version = C.specVersion pd+  cover 10 "format version before 1.10" (version < C.CabalSpecV1_10)+  cover 5 "format version 3.16 or later" (version >= C.CabalSpecV3_16)+  cover 50 "conditional branches" (hasBranches gpd)+  cover 20 "multi-line description" ('\n' `elem` C.fromShortText (C.description pd))+  cover 30 "sub-libraries" (not (null (C.condSubLibraries gpd)))+  cover 10 "custom-setup section" (C.setupBuildInfo pd /= Nothing)+  let bytes = TE.encodeUtf8 (T.pack (C.showGenericPackageDescription gpd))+  reference <- evalEither (snd (runResult (C.parseGenericPackageDescription bytes)))+  ours <- evalEither (A.parseValue (A.parsePackage bytes))+  converted <- evalEither (toCabal ours)+  converted === reference+  reference === gpd++-- | True if a component has a conditional branch.+hasBranches :: C.GenericPackageDescription -> Bool+hasBranches gpd = or+  [ maybe False branches (C.condLibrary gpd)+  , any (branches . snd) (C.condSubLibraries gpd)+  , any (branches . snd) (C.condExecutables gpd)+  , any (branches . snd) (C.condForeignLibs gpd)+  , any (branches . snd) (C.condTestSuites gpd)+  , any (branches . snd) (C.condBenchmarks gpd)+  ]+  where+    branches :: Tree a -> Bool+    branches = not . null . C.condTreeComponents++-- | The data that the generators of one package share.+data Context = Context+  { contextSpec :: C.CabalSpecVersion+  , packageName :: C.PackageName+  , subLibraries :: [C.UnqualComponentName]+  , flagNames :: [C.FlagName]+  }++since :: Context -> C.CabalSpecVersion -> Gen [a] -> Gen [a]+since ctx version gen = if contextSpec ctx >= version then gen else pure []++-- Names and atoms++-- | Parse a generated atom with Cabal-syntax. The generators make only+-- valid text, so an error is a generator bug.+atom :: C.Parsec a => String -> a+atom input = fromMaybe (error ("Generator made an invalid value: " ++ input)) (C.simpleParsec input)++-- | A letter. Some letters are not ASCII.+letter :: Gen Char+letter = Gen.frequency [(20, Gen.lower), (3, Gen.upper), (1, Gen.element ("éüßøλжé" :: String))]++lowerWord :: Gen String+lowerWord = (:) <$> Gen.lower <*> Gen.string (Range.linear 0 6) (Gen.frequency [(5, Gen.lower), (1, Gen.digit)])++upperWord :: Gen String+upperWord = (:) <$> Gen.upper <*> Gen.string (Range.linear 0 6)+  (Gen.frequency [(10, Gen.alphaNum), (1, Gen.element ("_'éλ" :: String))])++-- | A package or component name: parts with hyphens between them. Each+-- part contains a letter. Letters can be upper case or not ASCII.+genName :: Gen String+genName = concatWith '-' <$> Gen.list (Range.linear 1 3) part+  where+    part = do+      before <- Gen.string (Range.linear 0 2) Gen.digit+      first <- letter+      after <- Gen.string (Range.linear 0 5) (Gen.frequency [(4, letter), (1, Gen.digit)])+      pure (before ++ first : after)++concatWith :: Char -> [String] -> String+concatWith c = foldr1 (\a b -> a ++ c : b)++genModuleName :: Gen C.ModuleName+genModuleName = atom . concatWith '.' <$> Gen.list (Range.linear 1 3) upperWord++genModules :: Gen [C.ModuleName]+genModules = Gen.list (Range.linear 0 3) genModuleName++genVersion :: Gen C.Version+genVersion = C.mkVersion <$> Gen.list (Range.linear 1 4)+  (Gen.frequency [(10, Gen.int (Range.linear 0 20)), (1, Gen.int (Range.linear 0 999999999))])++-- | A path. Some paths contain spaces, characters that are not ASCII, or+-- glob characters. Some paths are absolute or start with "..".+genPath :: Gen FilePath+genPath = do+  start <- Gen.frequency [(10, pure ""), (1, pure "/"), (1, pure "../"), (1, pure "./")]+  parts <- Gen.list (Range.linear 1 3) segment+  pure (start ++ concatWith '/' parts)+  where+    segment = Gen.frequency+      [ (8, Gen.string (Range.linear 1 8) (Gen.frequency [(10, letter), (2, Gen.digit), (2, Gen.element ("-_." :: String))]))+      , (1, (\a b -> a ++ " " ++ b) <$> lowerWord <*> lowerWord)+      , (1, (++ ".hs") <$> upperWord)+      , (1, ("*." ++) <$> lowerWord)+      ]++-- | A relative path. Paths with a leading slash are absolute.+genRelativePath :: Gen FilePath+genRelativePath = Gen.filter (\p -> take 1 p /= "/") genPath++genPaths :: Gen [C.SymbolicPathX allowAbsolute from to]+genPaths = map C.unsafeMakeSymbolicPath . nub <$> Gen.list (Range.linear 0 3) genPath++genRelativePaths :: Gen [C.SymbolicPathX allowAbsolute from to]+genRelativePaths = map C.unsafeMakeSymbolicPath . nub <$> Gen.list (Range.linear 0 3) genRelativePath++-- | A command line option. Some options contain spaces, commas, or+-- characters that are not ASCII. The printer does not escape quotation+-- marks, so the options do not contain them.+genOption :: Gen String+genOption = Gen.frequency+  [ (6, ('-' :) <$> Gen.string (Range.linear 1 10) (Gen.frequency [(5, letter), (3, Gen.element ("0123=-_.:/+@#$%^&*()[]{}<>;!?~|\\" :: String))]))+  , (1, (\a b -> "-D" ++ a ++ "=" ++ b) <$> upperWord <*> lowerWord)+  , (1, (\a b -> a ++ " " ++ b) <$> lowerWord <*> lowerWord)+  , (1, (\a b -> a ++ "," ++ b) <$> lowerWord <*> lowerWord)+  ]++genOptions :: Gen [String]+genOptions = Gen.list (Range.linear 0 3) genOption++-- | A token without spaces, for example a library name.+genToken :: Gen String+genToken = Gen.string (Range.linear 1 8) (Gen.frequency [(10, letter), (2, Gen.digit), (1, Gen.element ("-_.+" :: String))])++-- | One line of free text without leading or trailing spaces. A line does+-- not start with "--", because Cabal reads such a line as a comment. The+-- text does not contain braces, because Cabal reads them as layout.+genLine :: Gen String+genLine = unwords <$> Gen.list (Range.linear 1 5) word+  where+    word = Gen.frequency+      [ (6, lowerWord)+      , (1, upperWord)+      , (1, Gen.element ["(a)", "x,y", "a--b", "é", "*", "λ", "a:b", "\"q\"", "<p>", "100%", "a;b", "#", "!"])+      ]++genShortText :: Gen C.ShortText+genShortText = C.toShortText <$> Gen.frequency [(2, pure ""), (3, genLine)]++-- | Free text with one or more lines. From format version 3.0, some lines+-- are empty or indented. The first line and the last line are not empty or+-- indented, because Cabal-syntax removes them. Before format version 3.0, Cabal-syntax removes+-- the indentation and ignores empty lines.+genFreeText :: C.CabalSpecVersion -> Gen String+genFreeText version = Gen.frequency+  [ (2, pure "")+  , (3, genLine)+  , (2, concatWith '\n' <$> Gen.list (Range.linear 2 4) genLine)+  , (if version >= C.CabalSpecV3_0 then 2 else 0, do+      first <- genLine+      middle <- Gen.list (Range.linear 1 4) (Gen.frequency+        [ (3, genLine)+        , (1, pure "")+        , (1, (++) <$> Gen.string (Range.linear 1 4) (pure ' ') <*> genLine)+        ])+      final <- genLine+      pure (concatWith '\n' (first : middle ++ [final])))+  ]++-- Versions and dependencies++-- | A version range. The printer does not write parentheses around an+-- operand with the same operator. In a dependency, the parser groups such+-- operators to the right. Thus an operand at the left of an operator never+-- uses the same operator. The printer does not write a range that contains+-- all versions, so such a range becomes 'C.anyVersion'.+genRange :: Context -> Gen C.VersionRange+genRange = genRangeWith foldr1++-- | A version range in an impl condition. In a condition, the parser groups+-- operators to the left.+genConditionRange :: Context -> Gen C.VersionRange+genConditionRange = genRangeWith foldl1++genRangeWith :: (forall a. (a -> a -> a) -> [a] -> a) -> Context -> Gen C.VersionRange+genRangeWith fold ctx = Gen.frequency [(2, pure C.anyVersion), (5, anyVersion <$> go (2 :: Int))]+  where+    anyVersion range = if C.isAnyVersion range then C.anyVersion else range+    go depth = fold C.unionVersionRanges <$> Gen.list (Range.linear 1 3) (conjunction depth)+    -- A union in parentheses occurs only as an operand of an intersection.+    conjunction depth = Gen.choice+      [ simple+      , fold C.intersectVersionRanges <$> Gen.list (Range.linear 2 3) (term depth)+      ]+    term depth+      | depth == 0 = simple+      | otherwise = Gen.frequency+          [ (4, simple)+          , (1, fold C.unionVersionRanges <$> Gen.list (Range.linear 2 3) (conjunction (depth - 1)))+          ]+    simple = Gen.element constructors <*> genVersion+    constructors = [C.thisVersion, C.laterVersion, C.earlierVersion, C.orLaterVersion, C.orEarlierVersion]+      ++ [C.majorBoundVersion | contextSpec ctx >= C.CabalSpecV2_0]++-- | The name of a package that is not this package. Before format version+-- 3.4, the name of a sub-library refers to the sub-library, so the name+-- is not the name of a sub-library.+genOtherPackage :: Context -> Gen C.PackageName+genOtherPackage ctx = Gen.filter allowed (Gen.frequency+  [ (3, C.mkPackageName <$> Gen.element ["base", "containers", "text", "bytestring", "mtl"])+  , (2, C.mkPackageName <$> genName)+  , (if null (subLibraries ctx) then 0 else 1, C.unqualComponentNameToPackageName <$> Gen.element (subLibraries ctx))+  ])+  where+    allowed name = name /= packageName ctx && (contextSpec ctx >= C.CabalSpecV3_4+      || C.packageNameToUnqualComponentName name `notElem` subLibraries ctx)++genLibraryName :: Gen C.LibraryName+genLibraryName = Gen.frequency+  [ (1, pure C.LMainLibName)+  , (2, C.LSubLibName . C.mkUnqualComponentName <$> genName)+  ]++genDependency :: Context -> Gen C.Dependency+genDependency ctx = Gen.frequency+  [ (4, C.Dependency <$> genOtherPackage ctx <*> genRange ctx <*> otherLibraries)+  , (1, C.Dependency (packageName ctx) <$> genRange ctx <*> ownLibraries)+  ]+  where+    -- The syntax for library sets starts in format version 3.0.+    otherLibraries+      | contextSpec ctx >= C.CabalSpecV3_0 = Gen.frequency+          [ (4, pure (NES.singleton C.LMainLibName))+          , (1, NES.fromNonEmpty <$> Gen.nonEmpty (Range.linear 1 3) genLibraryName)+          ]+      | otherwise = pure (NES.singleton C.LMainLibName)+    -- Before format version 3.0, the printer writes a dependency on a+    -- sub-library of this package with the name of the sub-library.+    ownLibraries+      | contextSpec ctx >= C.CabalSpecV3_0 = otherLibraries+      | otherwise = NES.singleton <$> Gen.element+          (C.LMainLibName : map C.LSubLibName (subLibraries ctx))++genMixin :: Context -> Gen C.Mixin+genMixin ctx = do+  (name, library) <- Gen.frequency+    [ (4, (,) <$> genOtherPackage ctx <*> otherLibrary)+    , (if null (subLibraries ctx) && contextSpec ctx < C.CabalSpecV3_4 then 0 else 1, (,) (packageName ctx) <$> ownLibrary)+    ]+  provides <- genRenaming+  requires <- genRenaming+  pure (C.mkMixin name library (C.IncludeRenaming provides requires))+  where+    -- The syntax for a sub-library in a mixin starts in format version 3.4.+    otherLibrary = if contextSpec ctx >= C.CabalSpecV3_4 then genLibraryName else pure C.LMainLibName+    -- Before format version 3.4, the printer writes a mixin of a+    -- sub-library of this package with the name of the sub-library.+    ownLibrary = if contextSpec ctx >= C.CabalSpecV3_4+      then genLibraryName+      else C.LSubLibName <$> Gen.element (subLibraries ctx)+    genRenaming = Gen.choice+      [ pure C.DefaultRenaming+      , C.ModuleRenaming <$> Gen.list (Range.linear 0 3) ((,) <$> genModuleName <*> genModuleName)+      , C.HidingRenaming <$> Gen.list (Range.linear 0 3) genModuleName+      ]++genToolDependency :: Context -> Gen C.ExeDependency+genToolDependency ctx = C.ExeDependency+  <$> Gen.choice [genOtherPackage ctx, pure (packageName ctx)]+  <*> (C.mkUnqualComponentName <$> genName) <*> genRange ctx++genLegacyTool :: Context -> Gen C.LegacyExeDependency+genLegacyTool ctx = C.LegacyExeDependency+  <$> Gen.frequency [(1, Gen.element ["happy", "alex", "c2hs", "hsc2hs", "cpphs"]), (2, genName)]+  <*> genRange ctx++-- | A pkg-config dependency. Versions with letters start in format version 3.0.+genPkgconfigDependency :: Context -> Gen C.PkgconfigDependency+genPkgconfigDependency ctx = do+  name <- genToken+  range <- Gen.element (["", " >= 1.2", " < 3 || > 4.1", " >= 1 && < 2"]+    ++ [" == 2.0.1a" | contextSpec ctx >= C.CabalSpecV3_0])+  let input = name ++ range+  pure (fromMaybe (error ("Generator made an invalid value: " ++ input)) (C.simpleParsec' (contextSpec ctx) input))++-- | An extension. The name of an unknown extension contains only letters+-- and digits.+genExtension :: Gen C.Extension+genExtension = Gen.frequency+  [ (10, C.EnableExtension <$> Gen.enumBounded)+  , (3, C.DisableExtension <$> Gen.enumBounded)+  , (1, C.UnknownExtension . ("Unknown" ++) <$> Gen.string (Range.linear 1 6) Gen.alphaNum)+  ]++genLanguage :: Gen C.Language+genLanguage = Gen.frequency+  [ (4, Gen.element C.knownLanguages)+  , (1, C.UnknownLanguage . ("Unknown" ++) <$> Gen.string (Range.linear 1 6) Gen.alphaNum)+  ]++-- Build information++-- | Build information for the format version of the context. A field that+-- the format version does not support stays empty. The grammar has no field+-- for 'C.staticOptions', so that value stays empty.+genBuildInfo :: Context -> Gen C.BuildInfo+genBuildInfo ctx = do+  buildable <- Gen.frequency [(4, pure True), (1, pure False)]+  sourceDirs <- genPaths+  other <- genModules+  autogen <- since' C.CabalSpecV2_0 genModules+  virtual <- since' C.CabalSpecV2_2 genModules+  language <- if contextSpec ctx >= C.CabalSpecV1_10 then Gen.maybe genLanguage else pure Nothing+  otherLanguages <- since' C.CabalSpecV1_10 (Gen.list (Range.linear 0 2) genLanguage)+  extensions <- since' C.CabalSpecV1_10 genExtensions+  otherExtensions <- since' C.CabalSpecV1_10 genExtensions+  -- The extensions field is not available from format version 3.0.+  oldExtensions <- if contextSpec ctx < C.CabalSpecV3_0 then genExtensions else pure []+  dependencies <- Gen.list (Range.linear 0 4) (genDependency ctx)+  mixins <- since' C.CabalSpecV2_0 (Gen.list (Range.linear 0 2) (genMixin ctx))+  tools <- Gen.list (Range.linear 0 2) (genToolDependency ctx)+  -- The build-tools field is not available from format version 3.0.+  legacyTools <- if contextSpec ctx < C.CabalSpecV3_0 then Gen.list (Range.linear 0 2) (genLegacyTool ctx) else pure []+  cSources <- genPaths+  cxxSources <- since' C.CabalSpecV2_2 genPaths+  asmSources <- since' C.CabalSpecV3_0 genPaths+  cmmSources <- since' C.CabalSpecV3_0 genPaths+  jsSources <- genPaths+  includeDirs <- genPaths+  includes <- genPaths+  installIncludes <- genRelativePaths+  autogenIncludes <- since' C.CabalSpecV3_0 genRelativePaths+  extraLibDirs <- genPaths+  extraLibDirsStatic <- since' C.CabalSpecV3_8 genPaths+  frameworks <- genRelativePaths+  frameworkDirs <- genPaths+  cppOptions <- genOptions+  ccOptions <- genOptions+  cxxOptions <- since' C.CabalSpecV2_2 genOptions+  jsppOptions <- since' C.CabalSpecV3_16 genOptions+  ldOptions <- genOptions+  asmOptions <- since' C.CabalSpecV3_0 genOptions+  cmmOptions <- since' C.CabalSpecV3_0 genOptions+  hsc2hsOptions <- since' C.CabalSpecV3_6 genOptions+  ghcOptions <- genOptions+  ghcjsOptions <- genOptions+  profOptions <- genOptions+  profjsOptions <- genOptions+  sharedOptions <- genOptions+  sharedjsOptions <- genOptions+  profSharedOptions <- since' C.CabalSpecV3_14 genOptions+  profSharedjsOptions <- since' C.CabalSpecV3_14 genOptions+  extraLibraries <- tokens+  extraLibrariesStatic <- since' C.CabalSpecV3_8 tokens+  extraGHCiLibraries <- tokens+  extraBundledLibraries <- tokens+  extraLibraryFlavours <- tokens+  extraDynamicFlavours <- since' C.CabalSpecV3_0 tokens+  pkgconfig <- Gen.list (Range.linear 0 2) (genPkgconfigDependency ctx)+  custom <- genCustomFields+  pure C.emptyBuildInfo+    { C.buildable = buildable+    , C.hsSourceDirs = sourceDirs+    , C.otherModules = other+    , C.autogenModules = autogen+    , C.virtualModules = virtual+    , C.defaultLanguage = language+    , C.otherLanguages = otherLanguages+    , C.defaultExtensions = extensions+    , C.otherExtensions = otherExtensions+    , C.oldExtensions = oldExtensions+    , C.targetBuildDepends = dependencies+    , C.mixins = mixins+    , C.buildToolDepends = tools+    , C.buildTools = legacyTools+    , C.cSources = cSources+    , C.cxxSources = cxxSources+    , C.asmSources = asmSources+    , C.cmmSources = cmmSources+    , C.jsSources = jsSources+    , C.includeDirs = includeDirs+    , C.includes = includes+    , C.installIncludes = installIncludes+    , C.autogenIncludes = autogenIncludes+    , C.extraLibDirs = extraLibDirs+    , C.extraLibDirsStatic = extraLibDirsStatic+    , C.frameworks = frameworks+    , C.extraFrameworkDirs = frameworkDirs+    , C.cppOptions = cppOptions+    , C.ccOptions = ccOptions+    , C.cxxOptions = cxxOptions+    , C.jsppOptions = jsppOptions+    , C.ldOptions = ldOptions+    , C.asmOptions = asmOptions+    , C.cmmOptions = cmmOptions+    , C.hsc2hsOptions = hsc2hsOptions+    , C.options = C.PerCompilerFlavor ghcOptions ghcjsOptions+    , C.profOptions = C.PerCompilerFlavor profOptions profjsOptions+    , C.sharedOptions = C.PerCompilerFlavor sharedOptions sharedjsOptions+    , C.profSharedOptions = C.PerCompilerFlavor profSharedOptions profSharedjsOptions+    , C.extraLibs = extraLibraries+    , C.extraLibsStatic = extraLibrariesStatic+    , C.extraGHCiLibs = extraGHCiLibraries+    , C.extraBundledLibs = extraBundledLibraries+    , C.extraLibFlavours = extraLibraryFlavours+    , C.extraDynLibFlavours = extraDynamicFlavours+    , C.pkgconfigDepends = pkgconfig+    , C.customFieldsBI = custom+    }+  where+    since' = since ctx+    genExtensions = Gen.list (Range.linear 0 3) genExtension+    tokens = Gen.list (Range.linear 0 2) genToken++-- | Fields with an @x-@ prefix. The names are unique. A value can have+-- more than one line. A field name contains only ASCII letters, digits,+-- hyphens, and underscores. Cabal-syntax changes field names to lower case.+genCustomFields :: Gen [(String, String)]+genCustomFields = do+  names <- nub <$> Gen.list (Range.linear 0 2) (("x-" ++) <$> Gen.string (Range.linear 1 10)+    (Gen.frequency [(10, Gen.lower), (2, Gen.digit), (1, Gen.element ("-_" :: String))]))+  traverse (\name -> (,) name <$> value) names+  where+    -- Cabal-syntax ignores empty lines and indentation in these values.+    value = concatWith '\n' <$> Gen.list (Range.linear 1 4) genLine++-- Components++type Tree a = C.CondTree C.ConfVar a++-- | A condition tree. Each node gets its data from the given generator.+-- The flag tells if the node is the top node.+genTree :: Context -> (Bool -> C.BuildInfo -> Gen a) -> Gen (Tree a)+genTree ctx make = go True (2 :: Int)+  where+    go top depth = do+      value <- genBuildInfo ctx >>= make top+      children <- if depth == 0 then pure [] else Gen.list (Range.linear 0 2) (branch (depth - 1))+      pure (C.CondNode value children)+    branch depth = C.CondBranch <$> genCondition ctx <*> go False depth <*> Gen.maybe (go False depth)++genCondition :: Context -> Gen (C.Condition C.ConfVar)+genCondition ctx = Gen.recursive Gen.choice leaves+  [ Gen.subterm (genCondition ctx) negation+  , Gen.subterm2 (genCondition ctx) (genCondition ctx) C.CAnd+  , Gen.subterm2 (genCondition ctx) (genCondition ctx) C.COr+  ]+  where+    -- The printer writes two negations as one "!!" token, which Cabal-syntax+    -- rejects.+    negation c@(C.CNot _) = c+    negation c = C.CNot c+    leaves =+      [ C.Lit <$> Gen.bool+      , C.Var . C.OS <$> Gen.frequency+          [(4, Gen.element C.knownOSs), (1, C.OtherOS . ("other" ++) <$> lowerWord)]+      , C.Var . C.Arch <$> Gen.frequency+          [(4, Gen.element C.knownArches), (1, C.OtherArch . ("other" ++) <$> lowerWord)]+      , C.Var <$> (C.Impl <$> genCompiler <*> genConditionRange ctx)+      ] ++ [C.Var . C.PackageFlag <$> Gen.element (flagNames ctx) | not (null (flagNames ctx))]++genCompiler :: Gen C.CompilerFlavor+genCompiler = Gen.frequency+  [ (4, Gen.element C.knownCompilerFlavors)+  , (1, C.OtherCompiler . ("other" ++) <$> lowerWord)+  ]++genLibrary :: Context -> C.LibraryName -> Bool -> C.BuildInfo -> Gen C.Library+genLibrary ctx name _ bi = do+  exposed <- genModules+  reexported <- Gen.list (Range.linear 0 2) genReexport+  signatures <- since ctx C.CabalSpecV2_0 genModules+  -- Only a sub-library has a visibility field.+  visibility <- case name of+    C.LSubLibName _ | contextSpec ctx >= C.CabalSpecV3_0 ->+      Gen.element [C.LibraryVisibilityPrivate, C.LibraryVisibilityPublic]+    C.LSubLibName _ -> pure C.LibraryVisibilityPrivate+    C.LMainLibName -> pure C.LibraryVisibilityPublic+  isExposed <- Gen.bool+  pure C.emptyLibrary+    { C.libName = name, C.exposedModules = exposed, C.reexportedModules = reexported+    , C.signatures = signatures, C.libExposed = isExposed, C.libVisibility = visibility+    , C.libBuildInfo = bi }+  where+    genReexport = C.ModuleReexport+      <$> Gen.maybe (Gen.choice [genOtherPackage ctx, pure (packageName ctx)])+      <*> genModuleName <*> genModuleName++genExecutable :: Context -> C.UnqualComponentName -> Bool -> C.BuildInfo -> Gen C.Executable+genExecutable ctx name _ bi = do+  mainIs <- Gen.frequency [(1, pure ""), (4, genRelativePath)]+  scope <- if contextSpec ctx >= C.CabalSpecV2_0+    then Gen.element [C.ExecutablePublic, C.ExecutablePrivate]+    else pure C.ExecutablePublic+  pure C.emptyExecutable+    { C.exeName = name, C.modulePath = C.unsafeMakeSymbolicPath mainIs+    , C.exeScope = scope, C.buildInfo = bi }++genForeignLibrary :: C.UnqualComponentName -> Bool -> C.BuildInfo -> Gen C.ForeignLib+genForeignLibrary name _ bi = do+  kind <- Gen.element C.knownForeignLibTypes+  options <- Gen.element [[], [C.ForeignLibStandalone]]+  versionInfo <- Gen.maybe (C.mkLibVersionInfo <$> ((,,) <$> small <*> small <*> small))+  versionLinux <- Gen.maybe genVersion+  modDefFiles <- genRelativePaths+  pure C.emptyForeignLib+    { C.foreignLibName = name, C.foreignLibType = kind, C.foreignLibOptions = options+    , C.foreignLibVersionInfo = versionInfo, C.foreignLibVersionLinux = versionLinux+    , C.foreignLibModDefFile = modDefFiles, C.foreignLibBuildInfo = bi }+  where+    small = Gen.int (Range.linear 0 100)++-- | A test suite. The top node always has an interface. A branch node can+-- have an interface or the value that Cabal-syntax gives to a branch+-- without a type field. Cabal-syntax does not keep the name in the test+-- suite value.+genTestSuite :: Context -> Bool -> C.BuildInfo -> Gen C.TestSuite+genTestSuite ctx top bi = do+  interface <- Gen.frequency+    [ (if top then 0 else 2, pure (C.TestSuiteUnsupported (C.TestTypeUnknown "" C.nullVersion)))+    , (2, C.TestSuiteExeV10 (C.mkVersion [1, 0]) . C.unsafeMakeSymbolicPath <$> genRelativePath)+    , (1, C.TestSuiteLibV09 (C.mkVersion [0, 9]) <$> genModuleName)+    ]+  generators <- since ctx C.CabalSpecV3_8 (Gen.list (Range.linear 0 2) genToken)+  pure C.emptyTestSuite+    { C.testInterface = interface, C.testBuildInfo = bi, C.testCodeGenerators = generators }++genBenchmark :: Bool -> C.BuildInfo -> Gen C.Benchmark+genBenchmark top bi = do+  interface <- Gen.frequency+    [ (if top then 0 else 2, pure (C.BenchmarkUnsupported (C.BenchmarkTypeUnknown "" C.nullVersion)))+    , (2, C.BenchmarkExeV10 (C.mkVersion [1, 0]) . C.unsafeMakeSymbolicPath <$> genRelativePath)+    ]+  pure C.emptyBenchmark { C.benchmarkInterface = interface, C.benchmarkBuildInfo = bi }++-- | Unique component names for one kind of component.+genComponentNames :: Int -> Gen [C.UnqualComponentName]+genComponentNames count = map C.mkUnqualComponentName . nub <$> Gen.list (Range.linear 0 count) genName++-- Package++genLicense :: C.CabalSpecVersion -> Gen (Either SPDX.License L.License)+genLicense version+  | version >= C.CabalSpecV2_2 = Left <$> Gen.frequency+      [ (1, pure SPDX.NONE)+      , (4, SPDX.License <$> expression (2 :: Int))+      ]+  | otherwise = Right <$> Gen.frequency+      [ (4, Gen.element L.knownLicenses)+      , (1, L.GPL . Just <$> genVersion)+      , (1, L.UnknownLicense . ("Unknown" ++) <$> Gen.string (Range.linear 1 6) Gen.alphaNum)+      ]+  where+    list = SPDX.cabalSpecVersionToSPDXListVersion version+    -- The printer writes an operand with the same operator without+    -- parentheses, and the parser groups the operators to the right.+    expression depth = foldr1 SPDX.EOr <$> Gen.list (Range.linear 1 3) (conjunction depth)+    -- A disjunction in parentheses occurs only as an operand of a conjunction.+    conjunction depth = Gen.choice+      [ simple+      , foldr1 SPDX.EAnd <$> Gen.list (Range.linear 2 3) (term depth)+      ]+    term depth+      | depth == 0 = simple+      | otherwise = Gen.frequency+          [ (4, simple)+          , (1, foldr1 SPDX.EOr <$> Gen.list (Range.linear 2 3) (conjunction (depth - 1)))+          ]+    simple = SPDX.ELicense <$> simpleLicense <*> Gen.frequency+      [(4, pure Nothing), (1, Just <$> Gen.element (SPDX.licenseExceptionIdList list))]+    simpleLicense = Gen.frequency+      [ (6, SPDX.ELicenseId <$> Gen.element (SPDX.licenseIdList list))+      , (1, SPDX.ELicenseIdPlus <$> Gen.element (SPDX.licenseIdList list))+      , (1, SPDX.ELicenseRef <$> (SPDX.mkLicenseRef' <$> Gen.maybe genToken <*> genToken))+      ]++genSourceRepo :: Gen C.SourceRepo+genSourceRepo = do+  kind <- Gen.frequency+    [(4, Gen.element [C.RepoHead, C.RepoThis]), (1, C.RepoKindUnknown . ("other" ++) <$> lowerWord)]+  kindOfRepo <- Gen.maybe (Gen.frequency+    [ (4, C.KnownRepoType <$> Gen.element C.knownRepoTypes)+    , (1, C.OtherRepoType . ("other" ++) <$> lowerWord)+    ])+  location <- Gen.maybe (Gen.frequency [(4, ("https://example.com/" ++) <$> genName), (1, genLine)])+  repoModule <- Gen.maybe genToken+  branch <- Gen.maybe genToken+  tag <- Gen.maybe genToken+  subdir <- Gen.maybe genPath+  pure (C.emptySourceRepo kind)+    { C.repoType = kindOfRepo, C.repoLocation = location, C.repoModule = repoModule+    , C.repoBranch = branch, C.repoTag = tag, C.repoSubdir = subdir }++-- | A build type and a custom-setup section.+--+-- * The custom-setup section starts in format version 1.24.+-- * Without a build-type field, the build type is Custom before format+--   version 2.2. From format version 2.2, the build type is Custom if a+--   custom-setup section is present, and Simple otherwise.+-- * From format version 1.24, a Custom build type needs a custom-setup+--   section.+-- * The Hooks build type starts in format version 3.14 and needs a+--   custom-setup section.+-- * The Make build type stops in format version 3.18.+genSetup :: Context -> Gen (Maybe C.BuildType, Maybe C.SetupBuildInfo)+genSetup ctx = do+  buildType <- Gen.maybe (Gen.element types)+  let effective = fromMaybe (if v >= C.CabalSpecV2_2 then C.Simple else C.Custom) buildType+      required = (effective == C.Custom && v >= C.CabalSpecV1_24) || effective == C.Hooks+  present <- if required then pure True else if v >= C.CabalSpecV1_24 then Gen.bool else pure False+  setup <- if present+    then Just . (`C.SetupBuildInfo` False) <$> Gen.list (Range.linear 0 3) (genDependency ctx)+    else pure Nothing+  -- A custom-setup section changes the default build type from format+  -- version 2.2, so the value must be explicit.+  let explicit = case buildType of+        Nothing | present && v >= C.CabalSpecV2_2 -> Just C.Custom+        _ -> buildType+  pure (explicit, setup)+  where+    v = contextSpec ctx+    types = [C.Simple, C.Configure, C.Custom]+      ++ [C.Make | v < C.CabalSpecV3_18] ++ [C.Hooks | v >= C.CabalSpecV3_14]++genFlag :: C.CabalSpecVersion -> C.FlagName -> Gen C.PackageFlag+genFlag version name = C.MkPackageFlag name <$> genFreeText version <*> Gen.bool <*> Gen.bool++-- | A flag name. Cabal-syntax changes flag names to lower case.+genFlagName :: Gen C.FlagName+genFlagName = C.mkFlagName <$> Gen.filter (\n -> take 1 n /= "-") (Gen.string (Range.linear 1 8)+  (Gen.frequency [(10, Gen.lower), (2, Gen.digit), (1, Gen.element ("-_" :: String))]))++genPackage :: Gen C.GenericPackageDescription+genPackage = do+  version <- Gen.enumBounded+  name <- C.mkPackageName <$> genName+  flags <- nub <$> Gen.list (Range.linear 0 3) genFlagName+  subLibraryNames <- filter ((/= name) . C.unqualComponentNameToPackageName) <$> genComponentNames 2+  let ctx = Context version name subLibraryNames flags+  packageVersion <- genVersion+  flagDeclarations <- traverse (genFlag version) flags+  license <- genLicense version+  licenseFiles <- genRelativePaths+  copyright <- genShortText+  maintainer <- genShortText+  author <- genShortText+  stability <- genShortText+  homepage <- genShortText+  packageUrl <- genShortText+  bugReports <- genShortText+  synopsis <- genShortText+  category <- genShortText+  description <- genFreeText version+  testedWith <- Gen.list (Range.linear 0 2) ((,) <$> genCompiler <*> genRange ctx)+  (buildType, setup) <- genSetup ctx+  repositories <- Gen.list (Range.linear 0 2) genSourceRepo+  custom <- genCustomFields+  extraSources <- genRelativePaths+  extraDocs <- genRelativePaths+  extraTemporary <- genRelativePaths+  extraFiles <- since ctx C.CabalSpecV3_14 genRelativePaths+  dataFiles <- genRelativePaths+  dataDir <- Gen.frequency [(3, pure C.sameDirectory), (1, C.unsafeMakeSymbolicPath <$> genPath)]+  library <- Gen.maybe (genTree ctx (genLibrary ctx C.LMainLibName))+  libraries <- traverse (\n -> (,) n <$> genTree ctx (genLibrary ctx (C.LSubLibName n))) subLibraryNames+  exeNames <- genComponentNames 2+  executables <- traverse (\n -> (,) n <$> genTree ctx (genExecutable ctx n)) exeNames+  foreignNames <- genComponentNames 1+  foreignLibraries <- traverse (\n -> (,) n <$> genTree ctx (genForeignLibrary n)) foreignNames+  testNames <- genComponentNames 2+  tests <- traverse (\n -> (,) n <$> genTree ctx (genTestSuite ctx)) testNames+  benchNames <- genComponentNames 1+  benchmarks <- traverse (\n -> (,) n <$> genTree ctx genBenchmark) benchNames+  let pd = C.emptyPackageDescription+        { C.specVersion = version+        , C.package = C.PackageIdentifier name packageVersion+        , C.licenseRaw = license+        , C.licenseFiles = licenseFiles+        , C.copyright = copyright+        , C.maintainer = maintainer+        , C.author = author+        , C.stability = stability+        , C.homepage = homepage+        , C.pkgUrl = packageUrl+        , C.bugReports = bugReports+        , C.synopsis = synopsis+        , C.category = category+        , C.description = C.toShortText description+        , C.testedWith = testedWith+        , C.buildTypeRaw = buildType+        , C.setupBuildInfo = setup+        , C.sourceRepos = repositories+        , C.customFieldsPD = custom+        , C.extraSrcFiles = extraSources+        , C.extraDocFiles = extraDocs+        , C.extraTmpFiles = extraTemporary+        , C.extraFiles = extraFiles+        , C.dataFiles = dataFiles+        , C.dataDir = dataDir+        }+  pure C.emptyGenericPackageDescription+    { C.packageDescription = pd+    , C.genPackageFlags = flagDeclarations+    , C.condLibrary = library+    , C.condSubLibraries = libraries+    , C.condExecutables = executables+    , C.condForeignLibs = foreignLibraries+    , C.condTestSuites = tests+    , C.condBenchmarks = benchmarks+    }

@@ -0,0 +1,67 @@+cabal-version: 3.8+name: aihc-hackage+version: 0.1.0.0+build-type: Simple++library+  exposed-modules:+    Aihc.Hackage.Cabal+    Aihc.Hackage.Cache+    Aihc.Hackage.Cpp+    Aihc.Hackage.Download+    Aihc.Hackage.Headers+    Aihc.Hackage.Index+    Aihc.Hackage.IndexCache+    Aihc.Hackage.Preprocessor+    Aihc.Hackage.Release+    Aihc.Hackage.Types+    Aihc.Hackage.Util++  hs-source-dirs: src+  build-depends:+    Cabal >=3.14 && <3.17,+    Cabal-syntax >=3.14 && <3.17,+    base >=4.16 && <5,+    bytestring >=0.10.8 && <0.13,+    containers >=0.5 && <0.9,+    directory >=1.2.3 && <1.5,+    filepath >=1.3.0.1 && <1.6,+    http-client >=0.5 && <0.8,+    http-client-tls >=0.2 && <0.4,+    http-types >=0.9 && <0.13,+    tar >=0.5 && <0.7,+    text >=1.2.3 && <2.2,+    time >=1.9 && <1.15,+    zlib >=0.5.4 && <0.8,++  ghc-options: -Wall+  default-language: GHC2021++test-suite spec+  type: exitcode-stdio-1.0+  hs-source-dirs: test+  main-is: Spec.hs+  build-depends:+    Cabal-syntax >=3.14 && <3.17,+    aihc-cpp >=2.0 && <2.1,+    aihc-hackage,+    base >=4.16 && <5,+    bytestring,+    containers,+    directory,+    filepath,+    hedgehog,+    tar,+    tasty,+    tasty-hedgehog,+    tasty-hunit,+    text,+    zlib,++  ghc-options:+    -Wall+    -threaded+    -rtsopts+    "-with-rtsopts=-N -M10G"++  default-language: GHC2021

@@ -0,0 +1,78 @@+cabal-version: 3.8+name: aihc-haddock+version: 0.1.0.0+build-type: Simple++library+  exposed-modules:+    Aihc.Haddock.Build+    Aihc.Haddock.Cli+    Aihc.Haddock.Comment+    Aihc.Haddock.Compare+    Aihc.Haddock.Hoogle+    Aihc.Haddock.Markup+    Aihc.Haddock.Model+    Aihc.Haddock.Package+    Aihc.Haddock.Reference.Hoogle+    Aihc.Haddock.Reference.Json+    Aihc.Haddock.Render+    Aihc.Haddock.Store++  hs-source-dirs: src+  build-depends:+    Cabal-syntax >=3.14 && <3.17,+    aeson >=2.0 && <2.3,+    aeson-pretty,+    aihc-hackage,+    aihc-package-plan,+    aihc-parser,+    base >=4.16 && <5,+    bytestring >=0.10.8 && <0.13,+    containers >=0.5 && <0.9,+    directory >=1.2.3 && <1.5,+    filepath >=1.3.0.1 && <1.6,+    optparse-applicative >=0.16 && <0.19,+    prettyprinter,+    text >=2.1.4 && <2.2,+    transformers,++  ghc-options: -Wall+  default-language: GHC2021++executable aihc-haddock+  main-is: Main.hs+  hs-source-dirs: app+  build-depends:+    aihc-haddock,+    base >=4.16 && <5,++  ghc-options: -Wall+  default-language: GHC2021++test-suite spec+  type: exitcode-stdio-1.0+  hs-source-dirs: test+  main-is: Spec.hs+  other-modules:+    Test.Haddock.Fixtures+    Test.Haddock.Units++  build-depends:+    aihc-hackage,+    aihc-haddock,+    base >=4.16 && <5,+    bytestring,+    directory,+    filepath,+    tasty,+    tasty-hedgehog,+    tasty-hunit,+    text,++  ghc-options:+    -Wall+    -threaded+    -rtsopts+    "-with-rtsopts=-N -M10G"++  default-language: GHC2021

@@ -0,0 +1,60 @@+cabal-version: 3.8+name: aihc-package-plan+version: 0.1.0.0+build-type: Simple++library+  exposed-modules:+    Aihc.PackagePlan+    Aihc.PackagePlan.Diagnostic+    Aihc.PackagePlan.Lock+    Aihc.PackagePlan.Solver+    Aihc.PackagePlan.Source++  hs-source-dirs: src+  build-depends:+    Cabal-syntax >=3.14 && <3.17,+    aeson >=2.0 && <2.3,+    aihc-cpp,+    aihc-hackage,+    aihc-parser,+    base >=4.16 && <5,+    bytestring >=0.10.8 && <0.13,+    containers >=0.5 && <0.9,+    cryptohash-sha256 >=0.11 && <0.12,+    directory >=1.2.3 && <1.5,+    filepath >=1.3.0.1 && <1.6,+    text >=2.1.4 && <2.2,+    time >=1.9 && <1.15,+    transformers,++  default-extensions: OverloadedStrings+  ghc-options: -Wall+  default-language: GHC2021++test-suite spec+  type: exitcode-stdio-1.0+  hs-source-dirs: test+  main-is: Spec.hs+  build-depends:+    Cabal-syntax >=3.14 && <3.17,+    aihc-hackage,+    aihc-package-plan,+    base >=4.16 && <5,+    bytestring,+    containers,+    directory,+    filepath,+    hedgehog,+    tar,+    tasty,+    tasty-hedgehog,+    tasty-hunit,++  ghc-options:+    -Wall+    -threaded+    -rtsopts+    -with-rtsopts=-N++  default-language: GHC2021