makeFieldLabelsNoPrefix throws error on Network.Wai.Handler.Warp.Internal.Settings

[MangoIV]

Hi, get a type error using the makeFieldLabelsNoPrefix ''Settings TH.

src/Extras/Optics.hs:12:1: error:
    • Could not deduce ((b :: Type)
                        ~ (((forall a1. IO a1 -> IO a1) -> IO ()) -> IO () :: Type))
      from the context: ((k :: optics-core-0.4.1.1:Optics.Internal.Optic.Types.OpticKind)
                         ~ (optics-core-0.4.1.1:Optics.Internal.Optic.Types.A_Lens :: optics-core-0.4.1.1:Optics.Internal.Optic.Types.OpticKind),
                         (a :: Type)
                         ~ (((forall a1. IO a1 -> IO a1) -> IO ()) -> IO () :: Type),
                         (b :: Type)
                         ~ (((forall a1. IO a1 -> IO a1) -> IO ()) -> IO () :: Type))
        bound by the instance declaration at src/Extras/Optics.hs:12:1-34
    • Cannot equate type variable ‘b’
      with a type involving polytypes:
        ((forall a1. IO a1 -> IO a1) -> IO ()) -> IO ()
      ‘b’ is a rigid type variable bound by
        the instance declaration
        at src/Extras/Optics.hs:12:1-34
    • In the 12th argument of ‘warp-3.3.25:Network.Wai.Handler.Warp.Settings.Settings’, namely
        ‘y_a6Lx’
      In the expression:
        (((((((((((((((((((((((((((warp-3.3.25:Network.Wai.Handler.Warp.Settings.Settings
                                     x1_a6L5)
                                    x2_a6L6)
                                   x3_a6L7)
                                  x4_a6L8)
                                 x5_a6L9)
                                x6_a6La)
                               x7_a6Lb)
                              x8_a6Lc)
                             x9_a6Ld)
                            x10_a6Le)
                           x11_a6Lf)
                          y_a6Lx)
                         x13_a6Lh)
                        x14_a6Li)
                       x15_a6Lj)
                      x16_a6Lk)
                     x17_a6Ll)
                    x18_a6Lm)
                   x19_a6Ln)
                  x20_a6Lo)
                 x21_a6Lp)
                x22_a6Lq)
               x23_a6Lr)
              x24_a6Ls)
             x25_a6Lt)
            x26_a6Lu)
           x27_a6Lv)
          x28_a6Lw
      In the first argument of ‘fmap’, namely
        ‘(\ y_a6Lx
            -> (((((((((((((((((((((((((((warp-3.3.25:Network.Wai.Handler.Warp.Settings.Settings
                                            x1_a6L5)
                                           x2_a6L6)
                                          x3_a6L7)
                                         x4_a6L8)
                                        x5_a6L9)
                                       x6_a6La)
                                      x7_a6Lb)
                                     x8_a6Lc)
                                    x9_a6Ld)
                                   x10_a6Le)
                                  x11_a6Lf)
                                 y_a6Lx)
                                x13_a6Lh)
                               x14_a6Li)
                              x15_a6Lj)
                             x16_a6Lk)
                            x17_a6Ll)
                           x18_a6Lm)
                          x19_a6Ln)
                         x20_a6Lo)
                        x21_a6Lp)
                       x22_a6Lq)
                      x23_a6Lr)
                     x24_a6Ls)
                    x25_a6Lt)
                   x26_a6Lu)
                  x27_a6Lv)
                 x28_a6Lw)’
    • Relevant bindings include
        y_a6Lx :: b (bound at src/Extras/Optics.hs:12:1)
        f_a6L3 :: a -> f b (bound at src/Extras/Optics.hs:12:1)
        labelOptic :: optics-core-0.4.1.1:Optics.Internal.Optic.Optic
                        k
                        optics-core-0.4.1.1:Optics.Internal.Optic.TypeLevel.NoIx
                        Settings
                        Settings
                        a
                        b
          (bound at src/Extras/Optics.hs:12:1)
   |
12 | makeFieldLabelsNoPrefix ''Settings
   | ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^

Even with -fprint-explicit-kinds and -fprint-explicit-runtime-reps This looks like ghc should be able to deduce the wanted constraint from the context.

GHC-Version is 9.4.6.

[MangoIV]

I think this is due to settingsFork field in Settings and ImpredicativeTypes

[phadej]

ImpredicativeTypes is out of reach for generating labels. But maybe we can skip that particular field. Opinions @adamgundry @arybczak ?

[MangoIV]

Sadly these higher rank types aren’t even allowed in instance heads so we couldn’t even ditch the ImpredicaticeTypes with the cost of worse error messages in instances derived for these types

[phadej]

@MangoIV

Sadly these higher rank types aren’t even allowed in instance heads

That is what I meant by "out of reach". There is no way to define LabelOptic (or HasField from GHC.Records or ...) for fields with ImpredicativeTypes or RankNTypes . AFAIK GHC gives up early on "fancy types" when solving HasField, IMO TH deriving machinery could too, if figuring out which types are "fancy types" is easy enough. Not only ImpredicativeTypes, but also existential types which we apparently already filter out:

*Optics> data Bar = forall a. Bar { barX :: a, barId :: a -> a, barInt :: Int }
*Optics> ; makeFieldLabels ''Bar
<interactive>:34:3-23: Splicing declarations
    makeFieldLabels ''Bar
  ======>
    instance (k_aqEV ~ A_Lens, a_aqEW ~ Int, b_aqEX ~ Int) =>
             LabelOptic "int" k_aqEV Bar Bar a_aqEW b_aqEX where
      {-# INLINE labelOptic #-}
      labelOptic
        = lensVL
            (\ f_aqEY s_aqEZ
               -> case s_aqEZ of {
                    Bar x1_aqF0 x2_aqF1 x3_aqF2
                      -> (fmap (\ y_aqF3 -> ((Bar x1_aqF0) x2_aqF1) y_aqF3))
                           (f_aqEY x3_aqF2) })

Note that for rank2types we generate getters:

*Optics> data Quu = Quu { quu :: forall a. a -> a }
*Optics> ; makeFieldLabelsNoPrefix  ''Quu
<interactive>:42:3-32: Splicing declarations
    makeFieldLabelsNoPrefix ''Quu
  ======>
    instance (Optics.Internal.Magic.Dysfunctional "quu" k_ar0G Quu Quu a_ar0H b_ar0I,
              k_ar0G ~ A_Getter,
              a_ar0H ~ (a_aqZC -> a_aqZC),
              b_ar0I ~ (a_aqZC -> a_aqZC)) =>
             LabelOptic "quu" k_ar0G Quu Quu a_ar0H b_ar0I where
      {-# INLINE labelOptic #-}
      labelOptic
        = to (\ s_ar0J -> case s_ar0J of { Quu x_ar0K -> x_ar0K })

but for higher ranks, there isn't much we can do.

It looks like that there is already some fancy types detection (skipping existential types, getters for rank2types), so it could be extended (to skip rankNtypes fields). PR welcome!

[adamgundry]

Yes, I agree with your analysis @phadej. We should skip higher-rank fields rather than generating type-incorrect instances.

Although we could generate instances that appeal to TypeError/Unsatisfiable, so we can give a sensible error message if a user tries to use such a field?

[phadej]

Although we could generate instances that appeal to

That's an orthogonal aspect. (We already don't generate optics for fields mentioning existential types).