Add support for gafield as a label in GHC >= 9.6 (#501)

* Add support for gafield as a label in GHC >= 9.6

* Add comments

optics-core/src/Optics/Generic.hs

@@ -176,6 +176,14 @@ instance (a ~ Void0, b ~ Void0) => GField name Void0 Void0 a b where
 -- ...In the...
 -- ...
 --
+-- /Note:/ 'gafield' is supported by 'Optics.Label.labelOptic' and can be used
+-- with a concise syntax via @OverloadedLabels@ with GHC >= 9.6.
+--
+-- @
+-- λ> herring ^? #"?name"
+-- Just \"Henry\"
+-- @
+--
 -- @since 0.4
 --
 class GAffineField (name :: Symbol) s t a b | name s -> t a b

optics-core/src/Optics/Label.hs

@@ -533,9 +533,14 @@ type GenericLabelOpticContext repDefined name k s t a b =
   , repDefined ~ (Defined (Rep s) && Defined (Rep t))
 #endif
   , Unless repDefined (NoLabelOpticError name k s t a b)
+  -- If a label starts with "_[A-Z]", assume it's a name of a constructor.
+  -- Otherwise, if it starts with "?[a-z]", assume it's a name of a partial
+  -- field. Otherwise it's a total field.
   , k ~ If (CmpSymbol "_@" name == 'LT && CmpSymbol "_[" name == 'GT)
            A_Prism
-           A_Lens
+           (If (CmpSymbol "?`" name == 'LT && CmpSymbol "?{" name == 'GT)
+               An_AffineTraversal
+               A_Lens)
   , GenericOptic repDefined name k s t a b
   , Dysfunctional name k s t a b
   )
@@ -593,10 +598,18 @@ instance
   ) => GenericOptic repDefined name A_Lens s t a b where
   genericOptic = gfieldImpl @name
 
+-- | This instance can only be used via label syntax with GHC >= 9.6 since it's
+-- the first release with unrestricted overloaded labels.
+instance
+  ( GAffineFieldImpl repDefined name s t a b
+  , origName ~ AppendSymbol "?" name
+  ) => GenericOptic repDefined origName An_AffineTraversal s t a b where
+  genericOptic = gafieldImpl @repDefined @name
+
 instance
   ( GConstructorImpl repDefined name s t a b
-  , _name ~ AppendSymbol "_" name
-  ) => GenericOptic repDefined _name A_Prism s t a b where
+  , origName ~ AppendSymbol "_" name
+  ) => GenericOptic repDefined origName A_Prism s t a b where
   genericOptic = gconstructorImpl @repDefined @name
 
 ----------------------------------------

optics/tests/Optics/Tests/Labels/Generic.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE CPP #-}
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE NamedFieldPuns #-}
@@ -90,7 +91,11 @@ label4rhs s b = s { fish = case fish s of
                   }
 
 label5lhs, label5rhs :: Human Mammal -> Bool -> Human Mammal
+#if __GLASGOW_HASKELL__ >= 906
+label5lhs s b = set (#pets % traversed % #"?lazy") b s
+#else
 label5lhs s b = set (#pets % traversed % gafield @"lazy") b s
+#endif
 label5rhs s b = s { pets = (`map` pets s) $ \case
                       Dog name0 age0   -> Dog { name = name0, age = age0 }
                       Cat name0 age0 _ -> Cat { name = name0, age = age0, lazy = b }
@@ -152,7 +157,11 @@ howManyGoldFish :: Int
 howManyGoldFish = lengthOf (#pets % folded % #_GoldFish) humanWithFish
 
 hasLazyPets :: Bool
+#if __GLASGOW_HASKELL__ >= 906
+hasLazyPets = orOf (#pets % folded % #"?lazy") human
+#else
 hasLazyPets = orOf (#pets % folded % gafield @"lazy") human
+#endif
 
 yearLater :: Human Mammal
 yearLater = human & #age %~ (+1)