HList implementation details "leaking"

HList inferred types.md

This is an example inferred type from some code I've written using HList (from darcs) and HListPP:

:t sinkWindow
sinkWindow
  :: (Data.HList.Labelable.LabeledOpticF
        (LabelableTy r4) (Const Int),
      Data.HList.Labelable.LabeledOpticP (LabelableTy r4) (->),
      Data.HList.Labelable.LabeledOpticTo
        (LabelableTy r4) "bgWindow" (->),
      Data.HList.Labelable.LabeledOpticF (LabelableTy r) (Const Int),
      Data.HList.Labelable.LabeledOpticP (LabelableTy r) (->),
      Data.HList.Labelable.LabeledOpticTo (LabelableTy r) "nThread" (->),
      Data.HList.Labelable.LabeledOpticTo (LabelableTy r) "nChunk" (->),
      Data.HList.Labelable.LabeledOpticF (LabelableTy r1) (Const Word8),
      Data.HList.Labelable.LabeledOpticP (LabelableTy r1) (->),
      Data.HList.Labelable.LabeledOpticTo
        (LabelableTy r1) "thresholdLevel" (->),
      Data.HList.Labelable.LabeledOpticF (LabelableTy r1) (Const Int),
      Data.HList.Labelable.LabeledOpticTo (LabelableTy r1) "erode" (->),
      Data.HList.Labelable.LabeledOpticTo (LabelableTy r1) "dilate" (->),
      Data.HList.Labelable.LabeledOpticF (LabelableTy r4) (Const (r1 s)),
      Data.HList.Labelable.LabeledOpticTo
        (LabelableTy r4) "segmentParms" (->),
      Data.HList.Labelable.LabeledOpticTo (LabelableTy r) "length" (->),
      Data.HList.Labelable.LabeledOpticTo (LabelableTy r) "overlap" (->),
      Data.HList.Labelable.LabeledOpticF (LabelableTy r4) (Const (r t)),
      Data.HList.Labelable.LabeledOpticF
        (LabelableTy r4) (Const (Maybe (Record s1))),
      Data.HList.Labelable.LabeledOpticTo (LabelableTy r4) "sinks" (->),
      Data.HList.Labelable.LabeledOpticF
        (LabelableTy r5) (Const (Maybe (Record s1))),
      Data.HList.Labelable.LabeledOpticP (LabelableTy r5) (->),
      Data.HList.Labelable.LabeledOpticTo (LabelableTy r5) "thresh" (->),
      HUpdateAtHNat n5 (Tagged "fps" Double) s1,
      HUpdateAtHNat n4 (Tagged "bufferSize" Int) s1,
      HUpdateAtHNat n3 (Tagged "file" [Char]) s1,
      HUpdateAtHNat n2 (Tagged "fourcc" (Char, Char, Char, Char)) s1,
      HUpdateAtHNat n1 (Tagged "fpsLimit" (Maybe Int)) s1,
      HUpdateAtHNat n (Tagged "window" [Char]) s1,
      HFind1 "window" (UnLabel "window" (LabelsOf s1)) n,
      HFind1 "fpsLimit" (UnLabel "fpsLimit" (LabelsOf s1)) n1,
      HFind1 "fps" (UnLabel "fps" (LabelsOf s1)) n5,
      HFind1 "fourcc" (UnLabel "fourcc" (LabelsOf s1)) n2,
      HFind1 "file" (UnLabel "file" (LabelsOf s1)) n3,
      HFind1 "bufferSize" (UnLabel "bufferSize" (LabelsOf s1)) n4,
      SameLength' s1 s1, Labelable "thresholdLevel" r1 s s Word8 Word8,
      Labelable
        "thresh" r5 s2 t1 (Maybe (Record s1)) (Maybe (Record s1)),
      Labelable "sinks" r4 (e : e1 : es) (e : e1 : es) (r5 s2) (r5 t1),
      Labelable
        "segmentParms" r4 (e : e1 : es) (e : e1 : es) (r1 s) (r1 s),
      Labelable "overlap" r t t Int Int,
      Labelable "nThread" r t t Int Int,
      Labelable "nbChunk" r t t Int Int, Labelable "length" r t t Int Int,
      Labelable "erode" r1 s s Int Int,
      Labelable "dilate" r1 s s Int Int,
      Labelable "bgWindow" r4 (e : e1 : es) (e : e1 : es) (r t) (r t),
      HasField "window" (Record s1) [Char],
      HasField "sinks" (r4 (e : e1 : es)) (r3 (e4 : es2)),
      HasField "overlap" (r2 (e2 : e3 : es1)) Int,
      HasField "length" (r2 (e2 : e3 : es1)) Int,
      HasField "fpsLimit" (Record s1) (Maybe Int),
      HasField "fps" (Record s1) Double,
      HasField "fourcc" (Record s1) (Char, Char, Char, Char),
      HasField "file" (Record s1) [Char],
      HasField "csv0" (r3 (e4 : es2)) (Maybe FilePath),
      HasField "bufferSize" (Record s1) Int,
      HasField "bgWindow" (r4 (e : e1 : es)) (r2 (e2 : e3 : es1)),
      SameLabels s1 s1, HasDepth d1,
      HUpdateAtHNatR n5 (Tagged "fps" Double) s1 ~ s1,
      HUpdateAtHNatR n4 (Tagged "bufferSize" Int) s1 ~ s1,
      HUpdateAtHNatR n3 (Tagged "file" [Char]) s1 ~ s1,
      HUpdateAtHNatR n2 (Tagged "fourcc" (Char, Char, Char, Char)) s1
      ~ s1,
      HUpdateAtHNatR n1 (Tagged "fpsLimit" (Maybe Int)) s1 ~ s1,
      HUpdateAtHNatR n (Tagged "window" [Char]) s1 ~ s1) =>
     (Int, Int)
     -> r4 (e : e1 : es)
     -> ConduitM
          (Seq.Seq (Image 'Trichromatic d1 'NoROI))
          void-0.6.1:Data.Void.Void
          M
          ()

The above print as something much much shorter. Ideally it would be something like:

sinkWindow :: (
    s `HasFields`
              [ '("sinks", sinks),
                '("fps", Double),
                '("bgWindow", bgWindow),
                ...
              ],
    bgWindow `HasFields` [ ... ]
    ) => 
    (Int, Int) -> Record s -> ...

Even something where Labelable did not get expanded would be an improvement:

sinkWindow ::
  (Labelable Record "sinks" s s sinks sinks,
   Labelable Record "fps" s s Double Double,
   Labelable Record "bgWindow" s s (Record bgWindow) (Record bgWindow)
   ...) =>