labels: extract predicates

kcsongor · Mar 29, 2024 · 3475ce6 · 3475ce6
1 parent 688e41e
commit 3475ce6
Showing 1 changed file with 8 additions and 2 deletions.
diff --git a/generic-lens/src/Data/Generics/Labels.hs b/generic-lens/src/Data/Generics/Labels.hs
@@ -126,14 +126,20 @@ type family ClassifyLabel (name :: Symbol) :: LabelType where
   ClassifyLabel name =
     If (StartsWithDigit name)
       'PositionType
-      ( If (CmpSymbol "_@" name == 'LT && CmpSymbol "_[" name == 'GT)
+      ( If (StartsWithUnderscoreAndUpperCase name)
           'LegacyConstrType
-          ( If (CmpSymbol "@" name == 'LT && CmpSymbol "[" name == 'GT)
+          ( If (StartsWithUpperCase name)
               'ConstrType
               'FieldType
           )
       )
 
+type StartsWithUnderscoreAndUpperCase name =
+  CmpSymbol "_@" name == 'LT && CmpSymbol "_[" name == 'GT
+
+type StartsWithUpperCase name =
+  CmpSymbol "@" name == 'LT && CmpSymbol "[" name == 'GT
+
 instance ( labelType ~ ClassifyLabel name
          , IsLabelHelper labelType name p f s t a b
          , pafb ~ p a (f b), psft ~ p s (f t)) => IsLabel name (pafb -> psft) where