Require Applicative (g s) as a superclass of FieldGrammar

Thus acting on the old todo, which helps a little bit with boilerplate.

Author: Bodigrim

Cabal-syntax/src/Distribution/FieldGrammar/Class.hs

@@ -1,5 +1,7 @@
 {-# LANGUAGE ConstraintKinds #-}
 {-# LANGUAGE FunctionalDependencies #-}
+{-# LANGUAGE KindSignatures #-}
+{-# LANGUAGE QuantifiedConstraints #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE UndecidableSuperClasses #-}
@@ -13,6 +15,7 @@ module Distribution.FieldGrammar.Class
   , defaultFreeTextFieldDefST
   ) where
 
+import Data.Kind (Constraint, Type)
 import Distribution.Compat.Lens
 import Distribution.Compat.Prelude
 import Prelude ()
@@ -23,23 +26,22 @@ import Distribution.FieldGrammar.Newtypes
 import Distribution.Fields.Field
 import Distribution.Utils.ShortText
 
--- | 'FieldGrammar' is parametrised by
+-- | @g@ is parametrised by
 --
 -- * @s@ which is a structure we are parsing. We need this to provide prettyprinter
 -- functionality
 --
 -- * @a@ type of the field.
---
--- /Note:/ We'd like to have @forall s. Applicative (f s)@ context.
 class
   ( c SpecVersion
   , c TestedWith
   , c SpecLicense
   , c Token
   , c Token'
   , c FilePathNT
+  , forall s. Applicative (g s)
   ) =>
-  FieldGrammar c g
+  FieldGrammar (c :: Type -> Constraint) (g :: Type -> Type -> Type)
     | g -> c
   where
   -- | Unfocus, zoom out, /blur/ 'FieldGrammar'.
@@ -231,7 +233,7 @@ monoidalField fn l = monoidalFieldAla fn Identity l
 
 -- | Default implementation for 'freeTextFieldDefST'.
 defaultFreeTextFieldDefST
-  :: (Functor (g s), FieldGrammar c g)
+  :: FieldGrammar c g
   => FieldName
   -> ALens' s ShortText
   -- ^ lens into the field

Cabal-syntax/src/Distribution/PackageDescription/FieldGrammar.hs

@@ -95,8 +95,6 @@ import qualified Distribution.Types.Lens as L
 
 packageDescriptionFieldGrammar
   :: ( FieldGrammar c g
-     , Applicative (g PackageDescription)
-     , Applicative (g PackageIdentifier)
      , c (Identity BuildType)
      , c (Identity PackageName)
      , c (Identity Version)
@@ -166,8 +164,6 @@ packageDescriptionFieldGrammar =
 
 libraryFieldGrammar
   :: ( FieldGrammar c g
-     , Applicative (g Library)
-     , Applicative (g BuildInfo)
      , c (Identity LibraryVisibility)
      , c (List CommaFSep (Identity ExeDependency) ExeDependency)
      , c (List CommaFSep (Identity LegacyExeDependency) LegacyExeDependency)
@@ -218,8 +214,6 @@ libraryFieldGrammar n =
 
 foreignLibFieldGrammar
   :: ( FieldGrammar c g
-     , Applicative (g ForeignLib)
-     , Applicative (g BuildInfo)
      , c (Identity ForeignLibType)
      , c (Identity LibVersionInfo)
      , c (Identity Version)
@@ -264,8 +258,6 @@ foreignLibFieldGrammar n =
 
 executableFieldGrammar
   :: ( FieldGrammar c g
-     , Applicative (g Executable)
-     , Applicative (g BuildInfo)
      , c (Identity ExecutableScope)
      , c (List CommaFSep (Identity ExeDependency) ExeDependency)
      , c (List CommaFSep (Identity LegacyExeDependency) LegacyExeDependency)
@@ -339,8 +331,6 @@ testStanzaCodeGenerators f s = fmap (\x -> s{_testStanzaCodeGenerators = x}) (f
 
 testSuiteFieldGrammar
   :: ( FieldGrammar c g
-     , Applicative (g TestSuiteStanza)
-     , Applicative (g BuildInfo)
      , c (Identity ModuleName)
      , c (Identity TestType)
      , c (List CommaFSep (Identity ExeDependency) ExeDependency)
@@ -488,8 +478,6 @@ benchmarkStanzaBuildInfo f s = fmap (\x -> s{_benchmarkStanzaBuildInfo = x}) (f
 
 benchmarkFieldGrammar
   :: ( FieldGrammar c g
-     , Applicative (g BenchmarkStanza)
-     , Applicative (g BuildInfo)
      , c (Identity BenchmarkType)
      , c (Identity ModuleName)
      , c (List CommaFSep (Identity ExeDependency) ExeDependency)
@@ -597,7 +585,6 @@ unvalidateBenchmark b =
 
 buildInfoFieldGrammar
   :: ( FieldGrammar c g
-     , Applicative (g BuildInfo)
      , c (List CommaFSep (Identity ExeDependency) ExeDependency)
      , c (List CommaFSep (Identity LegacyExeDependency) LegacyExeDependency)
      , c (List CommaFSep (Identity PkgconfigDependency) PkgconfigDependency)
@@ -710,7 +697,6 @@ buildInfoFieldGrammar =
 
 hsSourceDirsGrammar
   :: ( FieldGrammar c g
-     , Applicative (g BuildInfo)
      , c (List FSep (SymbolicPathNT Pkg (Dir Source)) (SymbolicPath Pkg (Dir Source)))
      )
   => g BuildInfo [SymbolicPath Pkg (Dir Source)]
@@ -727,7 +713,7 @@ hsSourceDirsGrammar =
     wrongLens f bi = (\fps -> set L.hsSourceDirs fps bi) <$> f []
 
 optionsFieldGrammar
-  :: (FieldGrammar c g, Applicative (g BuildInfo), c (List NoCommaFSep Token' String))
+  :: (FieldGrammar c g, c (List NoCommaFSep Token' String))
   => g BuildInfo (PerCompilerFlavor [String])
 optionsFieldGrammar =
   PerCompilerFlavor
@@ -744,7 +730,7 @@ optionsFieldGrammar =
     extract flavor = L.options . lookupLens flavor
 
 profOptionsFieldGrammar
-  :: (FieldGrammar c g, Applicative (g BuildInfo), c (List NoCommaFSep Token' String))
+  :: (FieldGrammar c g, c (List NoCommaFSep Token' String))
   => g BuildInfo (PerCompilerFlavor [String])
 profOptionsFieldGrammar =
   PerCompilerFlavor
@@ -755,7 +741,7 @@ profOptionsFieldGrammar =
     extract flavor = L.profOptions . lookupLens flavor
 
 sharedOptionsFieldGrammar
-  :: (FieldGrammar c g, Applicative (g BuildInfo), c (List NoCommaFSep Token' String))
+  :: (FieldGrammar c g, c (List NoCommaFSep Token' String))
   => g BuildInfo (PerCompilerFlavor [String])
 sharedOptionsFieldGrammar =
   PerCompilerFlavor
@@ -766,7 +752,7 @@ sharedOptionsFieldGrammar =
     extract flavor = L.sharedOptions . lookupLens flavor
 
 profSharedOptionsFieldGrammar
-  :: (FieldGrammar c g, Applicative (g BuildInfo), c (List NoCommaFSep Token' String))
+  :: (FieldGrammar c g, c (List NoCommaFSep Token' String))
   => g BuildInfo (PerCompilerFlavor [String])
 profSharedOptionsFieldGrammar =
   PerCompilerFlavor
@@ -789,7 +775,7 @@ lookupLens k f p@(PerCompilerFlavor ghc ghcjs)
 -------------------------------------------------------------------------------
 
 flagFieldGrammar
-  :: (FieldGrammar c g, Applicative (g PackageFlag))
+  :: FieldGrammar c g
   => FlagName
   -> g PackageFlag PackageFlag
 flagFieldGrammar name =
@@ -805,7 +791,7 @@ flagFieldGrammar name =
 -------------------------------------------------------------------------------
 
 sourceRepoFieldGrammar
-  :: (FieldGrammar c g, Applicative (g SourceRepo), c (Identity RepoType))
+  :: (FieldGrammar c g, c (Identity RepoType))
   => RepoKind
   -> g SourceRepo SourceRepo
 sourceRepoFieldGrammar kind =
@@ -824,7 +810,7 @@ sourceRepoFieldGrammar kind =
 -------------------------------------------------------------------------------
 
 setupBInfoFieldGrammar
-  :: (FieldGrammar c g, Functor (g SetupBuildInfo), c (List CommaVCat (Identity Dependency) Dependency))
+  :: (FieldGrammar c g, c (List CommaVCat (Identity Dependency) Dependency))
   => Bool
   -> g SetupBuildInfo SetupBuildInfo
 setupBInfoFieldGrammar def =

Cabal-syntax/src/Distribution/Types/InstalledPackageInfo/FieldGrammar.hs

@@ -55,8 +55,6 @@ f <@> x = f <*> x
 
 ipiFieldGrammar
   :: ( FieldGrammar c g
-     , Applicative (g InstalledPackageInfo)
-     , Applicative (g Basic)
      , c (Identity AbiHash)
      , c (Identity LibraryVisibility)
      , c (Identity PackageName)
@@ -301,7 +299,6 @@ basicLibVisibility f b =
 
 basicFieldGrammar
   :: ( FieldGrammar c g
-     , Applicative (g Basic)
      , c (Identity LibraryVisibility)
      , c (Identity PackageName)
      , c (Identity UnqualComponentName)

cabal-install/src/Distribution/Client/BuildReports/Anonymous.hs

@@ -111,8 +111,7 @@ cabalInstallID =
 -------------------------------------------------------------------------------
 
 fieldDescrs
-  :: ( Applicative (g BuildReport)
-     , FieldGrammar c g
+  :: ( FieldGrammar c g
      , c (Identity Arch)
      , c (Identity CompilerId)
      , c (Identity FlagAssignment)

cabal-install/src/Distribution/Client/CmdInstall/ClientInstallFlags.hs

@@ -123,7 +123,6 @@ clientInstallOptions _ =
 
 clientInstallFlagsGrammar
   :: ( FieldGrammar c g
-     , Applicative (g ClientInstallFlags)
      , c (Identity (Flag Bool))
      , c (Flag' FilePathNT FilePath)
      , c (Identity (Flag OverwritePolicy))

cabal-install/src/Distribution/Client/ProjectConfig/Legacy.hs

@@ -1805,7 +1805,6 @@ legacyPackageConfigFieldDescrs =
 
 legacyPackageConfigFGSectionDescrs
   :: ( FieldGrammar c g
-     , Applicative (g SourceRepoList)
      , c (Identity RepoType)
      , c (List NoCommaFSep FilePathNT String)
      , c (NonEmpty' NoCommaFSep Token String)
@@ -1837,7 +1836,6 @@ legacyPackageConfigSectionDescrs =
 
 packageRepoSectionDescr
   :: ( FieldGrammar c g
-     , Applicative (g SourceRepoList)
      , c (Identity RepoType)
      , c (List NoCommaFSep FilePathNT String)
      , c (NonEmpty' NoCommaFSep Token String)

cabal-install/src/Distribution/Client/Types/SourceRepo.hs

@@ -102,7 +102,6 @@ srpCommandLensNE f s = fmap (\x -> s{srpCommand = maybe [] toList x}) (f (nonEmp
 
 sourceRepositoryPackageGrammar
   :: ( FieldGrammar c g
-     , Applicative (g SourceRepoList)
      , c (Identity RepoType)
      , c (List NoCommaFSep FilePathNT String)
      , c (NonEmpty' NoCommaFSep Token String)

changelog.d/pr-11821.md

@@ -0,0 +1,7 @@
+---
+synopsis: Require `Applicative (g s)` as a superclass of `FieldGrammar`
+packages: [Cabal-syntax,cabal-install]
+prs: 11821
+---
+
+This allows us to scrap a bit of boilerplate.