Stupid utilisation of impredicative polymorphism to merge the key lists of two maps with different value types using `on`. Do not try at home.

ExistentialMaps.hs

{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE ImpredicativeTypes #-} -- HIGHLY EXPERIMENTAL
import           Data.Map (Map)
import qualified Data.Map as Map
import           Data.Function

-- Say we want to define this function:
mergeKeys :: Map k a -> Map k b -> [k]

{- The obvious implementation is of course
    mergeKeys a b = Map.keys a <> Map.keys b
But what if we want to use `on`? This does not work:
    mergeKeys = (<>) `on` Map.keys
because now `mergeKeys` has type `Map k a -> Map k a -> [k]`, which isn't general enough.
This is because the type of (f `on` g) looks like `a -> a -> b`, and those `a`s have to refer to the same type,
so we need a way to represent the existential ("abstract") type `exists a. Map k a`.
The sane way to accomplish this is by enabling the ExistentialQuantification language extension provided by GHC,
and defining a new data type like:
    data MapWithKeyType k = forall a. M (Map k a)
(the `forall` there really means `exists`, because
    M :: forall a. Map k a -> MapWithKeyType k
is equivalent to
    M :: (exists a. Map k a) -> MapWithKeyType k
by currying)
But is there a way to do this without introducing a new type?
We can define a (rank-2) type synonym that represents our existential type: -}
type MapWithKeyType k = forall b. (forall a. Map k a -> b) -> b
{- This is the standard encoding of existential types in System F, using something analogous to a
double negation (this is also related to continuation-passing style translation).
We now need a way to instantiate our polymorphic type variables with this polymorphic type.
This is called impredicative polymorphism, and is enabled by the *HIGHLY EXPERIMENTAL*
ImpredicativeTypes language extension (see the GHC manual for more information).
We can now define our function like so: -}
mergeKeys a b = ($ a) <.> ($ b)
    where (<.>) = (<>) `on` (\(m :: MapWithKeyType k) -> m Map.keys)

main = print $ mergeKeys (Map.singleton "a" 1)
                         (Map.singleton "b" "foo")
-- ["a","b"]