{-# LANGUAGE TypeApplications #-}

module CabalGild.Action.Format where

import CabalGild.Compat.Cabal ()
import qualified CabalGild.Extra.FieldLine as FieldLine
import qualified CabalGild.Extra.Name as Name
import qualified CabalGild.Extra.String as String
import qualified CabalGild.Type.SomeParsecParser as SPP
import qualified Data.Functor.Identity as Identity
import qualified Data.Map as Map
import qualified Distribution.CabalSpecVersion as CabalSpecVersion
import qualified Distribution.FieldGrammar.Newtypes as Newtypes
import qualified Distribution.Fields as Fields
import qualified Distribution.ModuleName as ModuleName
import qualified Distribution.Parsec as Parsec
import qualified Distribution.Pretty as Pretty
import qualified Distribution.Types.Dependency as Dependency
import qualified Distribution.Types.ExeDependency as ExeDependency
import qualified Distribution.Types.ForeignLibOption as ForeignLibOption
import qualified Distribution.Types.LegacyExeDependency as LegacyExeDependency
import qualified Distribution.Types.Mixin as Mixin
import qualified Distribution.Types.ModuleReexport as ModuleReexport
import qualified Distribution.Types.PkgconfigDependency as PkgconfigDependency
import qualified Language.Haskell.Extension as Extension
import qualified Text.PrettyPrint as PrettyPrint

run ::
  (Applicative m, Monoid cs) =>
  CabalSpecVersion.CabalSpecVersion ->
  ([Fields.Field cs], cs) ->
  m ([Fields.Field cs], cs)
run :: forall (m :: * -> *) cs.
(Applicative m, Monoid cs) =>
CabalSpecVersion -> ([Field cs], cs) -> m ([Field cs], cs)
run CabalSpecVersion
csv ([Field cs]
fs, cs
cs) = ([Field cs], cs) -> m ([Field cs], cs)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CabalSpecVersion -> [Field cs] -> [Field cs]
forall cs.
Monoid cs =>
CabalSpecVersion -> [Field cs] -> [Field cs]
fields CabalSpecVersion
csv [Field cs]
fs, cs
cs)

fields ::
  (Monoid cs) =>
  CabalSpecVersion.CabalSpecVersion ->
  [Fields.Field cs] ->
  [Fields.Field cs]
fields :: forall cs.
Monoid cs =>
CabalSpecVersion -> [Field cs] -> [Field cs]
fields = (Field cs -> Field cs) -> [Field cs] -> [Field cs]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Field cs -> Field cs) -> [Field cs] -> [Field cs])
-> (CabalSpecVersion -> Field cs -> Field cs)
-> CabalSpecVersion
-> [Field cs]
-> [Field cs]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CabalSpecVersion -> Field cs -> Field cs
forall cs. Monoid cs => CabalSpecVersion -> Field cs -> Field cs
field

field ::
  (Monoid cs) =>
  CabalSpecVersion.CabalSpecVersion ->
  Fields.Field cs ->
  Fields.Field cs
field :: forall cs. Monoid cs => CabalSpecVersion -> Field cs -> Field cs
field CabalSpecVersion
csv Field cs
f = case Field cs
f of
  Fields.Field Name cs
n [FieldLine cs]
fls -> case FieldName
-> Map FieldName SomeParsecParser -> Maybe SomeParsecParser
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (Name cs -> FieldName
forall a. Name a -> FieldName
Name.value Name cs
n) Map FieldName SomeParsecParser
parsers of
    Maybe SomeParsecParser
Nothing -> Field cs
f
    Just SomeParsecParser
spp -> Name cs -> [FieldLine cs] -> Field cs
forall ann. Name ann -> [FieldLine ann] -> Field ann
Fields.Field Name cs
n ([FieldLine cs] -> Field cs) -> [FieldLine cs] -> Field cs
forall a b. (a -> b) -> a -> b
$ CabalSpecVersion
-> [FieldLine cs] -> SomeParsecParser -> [FieldLine cs]
forall cs.
Monoid cs =>
CabalSpecVersion
-> [FieldLine cs] -> SomeParsecParser -> [FieldLine cs]
fieldLines CabalSpecVersion
csv [FieldLine cs]
fls SomeParsecParser
spp
  Fields.Section Name cs
n [SectionArg cs]
sas [Field cs]
fs -> Name cs -> [SectionArg cs] -> [Field cs] -> Field cs
forall ann.
Name ann -> [SectionArg ann] -> [Field ann] -> Field ann
Fields.Section Name cs
n [SectionArg cs]
sas ([Field cs] -> Field cs) -> [Field cs] -> Field cs
forall a b. (a -> b) -> a -> b
$ CabalSpecVersion -> [Field cs] -> [Field cs]
forall cs.
Monoid cs =>
CabalSpecVersion -> [Field cs] -> [Field cs]
fields CabalSpecVersion
csv [Field cs]
fs

fieldLines ::
  (Monoid cs) =>
  CabalSpecVersion.CabalSpecVersion ->
  [Fields.FieldLine cs] ->
  SPP.SomeParsecParser ->
  [Fields.FieldLine cs]
fieldLines :: forall cs.
Monoid cs =>
CabalSpecVersion
-> [FieldLine cs] -> SomeParsecParser -> [FieldLine cs]
fieldLines CabalSpecVersion
csv [FieldLine cs]
fls (SPP.SomeParsecParser ParsecParser (c s b a)
pp) =
  case CabalSpecVersion
-> ParsecParser (c s b a)
-> String
-> FieldLineStream
-> Either ParseError (c s b a)
forall a.
CabalSpecVersion
-> ParsecParser a
-> String
-> FieldLineStream
-> Either ParseError a
Parsec.runParsecParser' CabalSpecVersion
csv ParsecParser (c s b a)
pp String
"" (FieldLineStream -> Either ParseError (c s b a))
-> FieldLineStream -> Either ParseError (c s b a)
forall a b. (a -> b) -> a -> b
$ [FieldLine cs] -> FieldLineStream
forall a. [FieldLine a] -> FieldLineStream
FieldLine.toFieldLineStream [FieldLine cs]
fls of
    Left ParseError
_ ->
      -- Parsing failed, so simply return the field lines as is.
      [FieldLine cs]
fls
    Right c s b a
r ->
      ((cs, String) -> FieldLine cs) -> [(cs, String)] -> [FieldLine cs]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(cs
c, String
l) -> cs -> FieldName -> FieldLine cs
forall ann. ann -> FieldName -> FieldLine ann
Fields.FieldLine cs
c (FieldName -> FieldLine cs) -> FieldName -> FieldLine cs
forall a b. (a -> b) -> a -> b
$ String -> FieldName
String.toUtf8 String
l)
        ([(cs, String)] -> [FieldLine cs])
-> (Doc -> [(cs, String)]) -> Doc -> [FieldLine cs]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [cs] -> [String] -> [(cs, String)]
forall a b. [a] -> [b] -> [(a, b)]
zip ((FieldLine cs -> cs) -> [FieldLine cs] -> cs
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap FieldLine cs -> cs
forall a. FieldLine a -> a
FieldLine.annotation [FieldLine cs]
fls cs -> [cs] -> [cs]
forall a. a -> [a] -> [a]
: cs -> [cs]
forall a. a -> [a]
repeat cs
forall a. Monoid a => a
mempty)
        ([String] -> [(cs, String)])
-> (Doc -> [String]) -> Doc -> [(cs, String)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines
        (String -> [String]) -> (Doc -> String) -> Doc -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Style -> Doc -> String
PrettyPrint.renderStyle Style
style
        (Doc -> [FieldLine cs]) -> Doc -> [FieldLine cs]
forall a b. (a -> b) -> a -> b
$ CabalSpecVersion -> c s b a -> Doc
forall a. Pretty a => CabalSpecVersion -> a -> Doc
Pretty.prettyVersioned CabalSpecVersion
csv c s b a
r

style :: PrettyPrint.Style
style :: Style
style =
  -- Everything should be on its own line.
  PrettyPrint.Style
    { mode :: Mode
PrettyPrint.mode = Mode
PrettyPrint.PageMode,
      lineLength :: Int
PrettyPrint.lineLength = Int
0,
      ribbonsPerLine :: Float
PrettyPrint.ribbonsPerLine = Float
1
    }

parsers :: Map.Map Fields.FieldName SPP.SomeParsecParser
parsers :: Map FieldName SomeParsecParser
parsers =
  -- Perhaps these should use paths as keys rather than field names. That's
  -- because some fields are only supposed to occur within certain sections.
  -- For example, `exposed-modules` occurs in (at least) `library`. Fortunately
  -- field names are unique enough for this not to be a problem.
  let (=:) :: String -> SPP.SomeParsecParser -> (Fields.FieldName, SPP.SomeParsecParser)
      =: :: String -> SomeParsecParser -> (FieldName, SomeParsecParser)
(=:) = (,) (FieldName -> SomeParsecParser -> (FieldName, SomeParsecParser))
-> (String -> FieldName)
-> String
-> SomeParsecParser
-> (FieldName, SomeParsecParser)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> FieldName
String.toUtf8
   in [(FieldName, SomeParsecParser)] -> Map FieldName SomeParsecParser
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
        [ String
"asm-options" String -> SomeParsecParser -> (FieldName, SomeParsecParser)
=: forall s b a.
(Parsec (List s b a), Pretty (List s b a)) =>
SomeParsecParser
SPP.list @Newtypes.NoCommaFSep @Newtypes.Token',
          String
"asm-sources" String -> SomeParsecParser -> (FieldName, SomeParsecParser)
=: forall s b a.
(Parsec (Set s b a), Pretty (Set s b a)) =>
SomeParsecParser
SPP.set @Newtypes.VCat @Newtypes.FilePathNT,
          String
"autogen-includes" String -> SomeParsecParser -> (FieldName, SomeParsecParser)
=: forall s b a.
(Parsec (Set s b a), Pretty (Set s b a)) =>
SomeParsecParser
SPP.set @Newtypes.FSep @Newtypes.FilePathNT,
          String
"autogen-modules" String -> SomeParsecParser -> (FieldName, SomeParsecParser)
=: forall s b a.
(Parsec (Set s b a), Pretty (Set s b a)) =>
SomeParsecParser
SPP.set @Newtypes.VCat @(Newtypes.MQuoted ModuleName.ModuleName),
          String
"build-depends" String -> SomeParsecParser -> (FieldName, SomeParsecParser)
=: forall s b a.
(Parsec (Set s b a), Pretty (Set s b a)) =>
SomeParsecParser
SPP.set @Newtypes.CommaVCat @(Identity.Identity Dependency.Dependency),
          String
"build-tool-depends" String -> SomeParsecParser -> (FieldName, SomeParsecParser)
=: forall s b a.
(Parsec (Set s b a), Pretty (Set s b a)) =>
SomeParsecParser
SPP.set @Newtypes.CommaFSep @(Identity.Identity ExeDependency.ExeDependency),
          String
"build-tools" String -> SomeParsecParser -> (FieldName, SomeParsecParser)
=: forall s b a.
(Parsec (Set s b a), Pretty (Set s b a)) =>
SomeParsecParser
SPP.set @Newtypes.CommaFSep @(Identity.Identity LegacyExeDependency.LegacyExeDependency),
          String
"c-sources" String -> SomeParsecParser -> (FieldName, SomeParsecParser)
=: forall s b a.
(Parsec (Set s b a), Pretty (Set s b a)) =>
SomeParsecParser
SPP.set @Newtypes.VCat @Newtypes.FilePathNT,
          String
"cc-options" String -> SomeParsecParser -> (FieldName, SomeParsecParser)
=: forall s b a.
(Parsec (List s b a), Pretty (List s b a)) =>
SomeParsecParser
SPP.list @Newtypes.NoCommaFSep @Newtypes.Token',
          String
"cmm-options" String -> SomeParsecParser -> (FieldName, SomeParsecParser)
=: forall s b a.
(Parsec (List s b a), Pretty (List s b a)) =>
SomeParsecParser
SPP.list @Newtypes.NoCommaFSep @Newtypes.Token',
          String
"cmm-sources" String -> SomeParsecParser -> (FieldName, SomeParsecParser)
=: forall s b a.
(Parsec (Set s b a), Pretty (Set s b a)) =>
SomeParsecParser
SPP.set @Newtypes.VCat @Newtypes.FilePathNT,
          String
"code-generators" String -> SomeParsecParser -> (FieldName, SomeParsecParser)
=: forall s b a.
(Parsec (List s b a), Pretty (List s b a)) =>
SomeParsecParser
SPP.list @Newtypes.CommaFSep @Newtypes.Token,
          String
"cpp-options" String -> SomeParsecParser -> (FieldName, SomeParsecParser)
=: forall s b a.
(Parsec (List s b a), Pretty (List s b a)) =>
SomeParsecParser
SPP.list @Newtypes.NoCommaFSep @Newtypes.Token',
          String
"cxx-options" String -> SomeParsecParser -> (FieldName, SomeParsecParser)
=: forall s b a.
(Parsec (List s b a), Pretty (List s b a)) =>
SomeParsecParser
SPP.list @Newtypes.NoCommaFSep @Newtypes.Token',
          String
"cxx-sources" String -> SomeParsecParser -> (FieldName, SomeParsecParser)
=: forall s b a.
(Parsec (Set s b a), Pretty (Set s b a)) =>
SomeParsecParser
SPP.set @Newtypes.VCat @Newtypes.FilePathNT,
          String
"data-files" String -> SomeParsecParser -> (FieldName, SomeParsecParser)
=: forall s b a.
(Parsec (Set s b a), Pretty (Set s b a)) =>
SomeParsecParser
SPP.set @Newtypes.VCat @Newtypes.FilePathNT,
          String
"default-extensions" String -> SomeParsecParser -> (FieldName, SomeParsecParser)
=: forall s b a.
(Parsec (Set s b a), Pretty (Set s b a)) =>
SomeParsecParser
SPP.set @Newtypes.FSep @(Newtypes.MQuoted Extension.Extension),
          String
"exposed-modules" String -> SomeParsecParser -> (FieldName, SomeParsecParser)
=: forall s b a.
(Parsec (Set s b a), Pretty (Set s b a)) =>
SomeParsecParser
SPP.set @Newtypes.VCat @(Newtypes.MQuoted ModuleName.ModuleName),
          String
"extensions" String -> SomeParsecParser -> (FieldName, SomeParsecParser)
=: forall s b a.
(Parsec (Set s b a), Pretty (Set s b a)) =>
SomeParsecParser
SPP.set @Newtypes.FSep @(Newtypes.MQuoted Extension.Extension),
          String
"extra-bundled-libraries" String -> SomeParsecParser -> (FieldName, SomeParsecParser)
=: forall s b a.
(Parsec (Set s b a), Pretty (Set s b a)) =>
SomeParsecParser
SPP.set @Newtypes.VCat @Newtypes.Token,
          String
"extra-doc-files" String -> SomeParsecParser -> (FieldName, SomeParsecParser)
=: forall s b a.
(Parsec (Set s b a), Pretty (Set s b a)) =>
SomeParsecParser
SPP.set @Newtypes.VCat @Newtypes.FilePathNT,
          String
"extra-dynamic-library-flavours" String -> SomeParsecParser -> (FieldName, SomeParsecParser)
=: forall s b a.
(Parsec (Set s b a), Pretty (Set s b a)) =>
SomeParsecParser
SPP.set @Newtypes.VCat @Newtypes.Token,
          String
"extra-framework-dirs" String -> SomeParsecParser -> (FieldName, SomeParsecParser)
=: forall s b a.
(Parsec (Set s b a), Pretty (Set s b a)) =>
SomeParsecParser
SPP.set @Newtypes.FSep @Newtypes.FilePathNT,
          String
"extra-ghci-libraries" String -> SomeParsecParser -> (FieldName, SomeParsecParser)
=: forall s b a.
(Parsec (Set s b a), Pretty (Set s b a)) =>
SomeParsecParser
SPP.set @Newtypes.VCat @Newtypes.Token,
          String
"extra-lib-dirs-static" String -> SomeParsecParser -> (FieldName, SomeParsecParser)
=: forall s b a.
(Parsec (Set s b a), Pretty (Set s b a)) =>
SomeParsecParser
SPP.set @Newtypes.FSep @Newtypes.FilePathNT,
          String
"extra-lib-dirs" String -> SomeParsecParser -> (FieldName, SomeParsecParser)
=: forall s b a.
(Parsec (Set s b a), Pretty (Set s b a)) =>
SomeParsecParser
SPP.set @Newtypes.FSep @Newtypes.FilePathNT,
          String
"extra-libraries-static" String -> SomeParsecParser -> (FieldName, SomeParsecParser)
=: forall s b a.
(Parsec (Set s b a), Pretty (Set s b a)) =>
SomeParsecParser
SPP.set @Newtypes.VCat @Newtypes.Token,
          String
"extra-libraries" String -> SomeParsecParser -> (FieldName, SomeParsecParser)
=: forall s b a.
(Parsec (Set s b a), Pretty (Set s b a)) =>
SomeParsecParser
SPP.set @Newtypes.VCat @Newtypes.Token,
          String
"extra-library-flavours" String -> SomeParsecParser -> (FieldName, SomeParsecParser)
=: forall s b a.
(Parsec (Set s b a), Pretty (Set s b a)) =>
SomeParsecParser
SPP.set @Newtypes.VCat @Newtypes.Token,
          String
"extra-source-files" String -> SomeParsecParser -> (FieldName, SomeParsecParser)
=: forall s b a.
(Parsec (Set s b a), Pretty (Set s b a)) =>
SomeParsecParser
SPP.set @Newtypes.VCat @Newtypes.FilePathNT,
          String
"extra-tmp-files" String -> SomeParsecParser -> (FieldName, SomeParsecParser)
=: forall s b a.
(Parsec (Set s b a), Pretty (Set s b a)) =>
SomeParsecParser
SPP.set @Newtypes.VCat @Newtypes.FilePathNT,
          String
"frameworks" String -> SomeParsecParser -> (FieldName, SomeParsecParser)
=: forall s b a.
(Parsec (Set s b a), Pretty (Set s b a)) =>
SomeParsecParser
SPP.set @Newtypes.FSep @Newtypes.Token,
          String
"ghc-options" String -> SomeParsecParser -> (FieldName, SomeParsecParser)
=: forall s b a.
(Parsec (List s b a), Pretty (List s b a)) =>
SomeParsecParser
SPP.list @Newtypes.NoCommaFSep @Newtypes.Token',
          String
"ghc-prof-options" String -> SomeParsecParser -> (FieldName, SomeParsecParser)
=: forall s b a.
(Parsec (List s b a), Pretty (List s b a)) =>
SomeParsecParser
SPP.list @Newtypes.NoCommaFSep @Newtypes.Token',
          String
"ghc-shared-options" String -> SomeParsecParser -> (FieldName, SomeParsecParser)
=: forall s b a.
(Parsec (List s b a), Pretty (List s b a)) =>
SomeParsecParser
SPP.list @Newtypes.NoCommaFSep @Newtypes.Token',
          String
"ghcjs-options" String -> SomeParsecParser -> (FieldName, SomeParsecParser)
=: forall s b a.
(Parsec (List s b a), Pretty (List s b a)) =>
SomeParsecParser
SPP.list @Newtypes.NoCommaFSep @Newtypes.Token',
          String
"ghcjs-prof-options" String -> SomeParsecParser -> (FieldName, SomeParsecParser)
=: forall s b a.
(Parsec (List s b a), Pretty (List s b a)) =>
SomeParsecParser
SPP.list @Newtypes.NoCommaFSep @Newtypes.Token',
          String
"ghcjs-shared-options" String -> SomeParsecParser -> (FieldName, SomeParsecParser)
=: forall s b a.
(Parsec (List s b a), Pretty (List s b a)) =>
SomeParsecParser
SPP.list @Newtypes.NoCommaFSep @Newtypes.Token',
          String
"hs-source-dirs" String -> SomeParsecParser -> (FieldName, SomeParsecParser)
=: forall s b a.
(Parsec (List s b a), Pretty (List s b a)) =>
SomeParsecParser
SPP.list @Newtypes.FSep @Newtypes.FilePathNT,
          String
"hsc2hs-options" String -> SomeParsecParser -> (FieldName, SomeParsecParser)
=: forall s b a.
(Parsec (List s b a), Pretty (List s b a)) =>
SomeParsecParser
SPP.list @Newtypes.NoCommaFSep @Newtypes.Token',
          String
"include-dirs" String -> SomeParsecParser -> (FieldName, SomeParsecParser)
=: forall s b a.
(Parsec (Set s b a), Pretty (Set s b a)) =>
SomeParsecParser
SPP.set @Newtypes.FSep @Newtypes.FilePathNT,
          String
"includes" String -> SomeParsecParser -> (FieldName, SomeParsecParser)
=: forall s b a.
(Parsec (Set s b a), Pretty (Set s b a)) =>
SomeParsecParser
SPP.set @Newtypes.FSep @Newtypes.FilePathNT,
          String
"install-includes" String -> SomeParsecParser -> (FieldName, SomeParsecParser)
=: forall s b a.
(Parsec (Set s b a), Pretty (Set s b a)) =>
SomeParsecParser
SPP.set @Newtypes.FSep @Newtypes.FilePathNT,
          String
"js-sources" String -> SomeParsecParser -> (FieldName, SomeParsecParser)
=: forall s b a.
(Parsec (Set s b a), Pretty (Set s b a)) =>
SomeParsecParser
SPP.set @Newtypes.VCat @Newtypes.FilePathNT,
          String
"ld-options" String -> SomeParsecParser -> (FieldName, SomeParsecParser)
=: forall s b a.
(Parsec (List s b a), Pretty (List s b a)) =>
SomeParsecParser
SPP.list @Newtypes.NoCommaFSep @Newtypes.Token',
          String
"license-files" String -> SomeParsecParser -> (FieldName, SomeParsecParser)
=: forall s b a.
(Parsec (Set s b a), Pretty (Set s b a)) =>
SomeParsecParser
SPP.set @Newtypes.FSep @Newtypes.FilePathNT,
          String
"mixins" String -> SomeParsecParser -> (FieldName, SomeParsecParser)
=: forall s b a.
(Parsec (Set s b a), Pretty (Set s b a)) =>
SomeParsecParser
SPP.set @Newtypes.CommaVCat @(Identity.Identity Mixin.Mixin),
          String
"options" String -> SomeParsecParser -> (FieldName, SomeParsecParser)
=: forall s b a.
(Parsec (Set s b a), Pretty (Set s b a)) =>
SomeParsecParser
SPP.set @Newtypes.FSep @(Identity.Identity ForeignLibOption.ForeignLibOption),
          String
"other-extensions" String -> SomeParsecParser -> (FieldName, SomeParsecParser)
=: forall s b a.
(Parsec (Set s b a), Pretty (Set s b a)) =>
SomeParsecParser
SPP.set @Newtypes.FSep @(Newtypes.MQuoted Extension.Extension),
          String
"other-languages" String -> SomeParsecParser -> (FieldName, SomeParsecParser)
=: forall s b a.
(Parsec (Set s b a), Pretty (Set s b a)) =>
SomeParsecParser
SPP.set @Newtypes.FSep @(Newtypes.MQuoted Extension.Language),
          String
"other-modules" String -> SomeParsecParser -> (FieldName, SomeParsecParser)
=: forall s b a.
(Parsec (Set s b a), Pretty (Set s b a)) =>
SomeParsecParser
SPP.set @Newtypes.VCat @(Newtypes.MQuoted ModuleName.ModuleName),
          String
"pkgconfig-depends" String -> SomeParsecParser -> (FieldName, SomeParsecParser)
=: forall s b a.
(Parsec (Set s b a), Pretty (Set s b a)) =>
SomeParsecParser
SPP.set @Newtypes.CommaFSep @(Identity.Identity PkgconfigDependency.PkgconfigDependency),
          String
"reexported-modules" String -> SomeParsecParser -> (FieldName, SomeParsecParser)
=: forall s b a.
(Parsec (Set s b a), Pretty (Set s b a)) =>
SomeParsecParser
SPP.set @Newtypes.CommaVCat @(Identity.Identity ModuleReexport.ModuleReexport),
          String
"setup-depends" String -> SomeParsecParser -> (FieldName, SomeParsecParser)
=: forall s b a.
(Parsec (Set s b a), Pretty (Set s b a)) =>
SomeParsecParser
SPP.set @Newtypes.CommaVCat @(Identity.Identity Dependency.Dependency),
          String
"signatures" String -> SomeParsecParser -> (FieldName, SomeParsecParser)
=: forall s b a.
(Parsec (Set s b a), Pretty (Set s b a)) =>
SomeParsecParser
SPP.set @Newtypes.VCat @(Newtypes.MQuoted ModuleName.ModuleName),
          String
"tested-with" String -> SomeParsecParser -> (FieldName, SomeParsecParser)
=: forall s b a.
(Parsec (Set s b a), Pretty (Set s b a)) =>
SomeParsecParser
SPP.set @Newtypes.FSep @Newtypes.TestedWith,
          String
"virtual-modules" String -> SomeParsecParser -> (FieldName, SomeParsecParser)
=: forall s b a.
(Parsec (Set s b a), Pretty (Set s b a)) =>
SomeParsecParser
SPP.set @Newtypes.VCat @(Newtypes.MQuoted ModuleName.ModuleName)
        ]