Optics composition with backwards reasoning

Joinable.js

{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}

module Main where

import Optics hiding ((%))
import qualified Optics

class (Is k m, Is l m, m ~ Join k l) => Joinable k l m

(%) :: forall k l m is js ks s t u v a b . (Joinable k l m, ks ~ Append is js)
     => Optic k is s t u v
     -> Optic l js u v a b
     -> Optic m ks s t a b
(%) = (Optics.%)

instance {-# INCOHERENT #-} l ~ A_Setter => Joinable A_Lens l A_Setter
instance {-# INCOHERENT #-} l ~ A_Setter => Joinable l A_Lens A_Setter
instance {-# INCOHERENT #-} l ~ A_Lens   => Joinable l A_Lens A_Lens
instance {-# INCOHERENT #-} l ~ A_Lens   => Joinable A_Lens l A_Lens
instance {-# INCOHERENT #-} l ~ A_Lens   => Joinable A_Lens A_Lens l

-- lots more instances here...


data Person =
  MkPerson
    { _name :: String
    , _numbers :: (Int, Int)
    }

makeLenses ''Person

p :: Person
p = MkPerson "Frodo" (66, 88)