Binary serialisation of existentials

Binary.hs

{-# LANGUAGE StaticPointers #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE ScopedTypeVariables #-}

import Data.Binary
import Data.Typeable
import System.IO.Unsafe
import GHC.StaticPtr

data Foo = forall a. (Typeable a, Binary a) => Foo a

main = do
    let a = encode $ Foo ("test" :: String)
    let b = encode $ Foo (123456 :: Int)
    let f s = case decode s of
            Foo x | Just (x :: String) <- cast x -> print x
                  | Just (x :: Int) <- cast x -> print x
                  | otherwise -> print $ typeOf x
    f a
    f b

instance Binary Foo where
  get :: Get Foo
  get = do
      ptr <- get
      case unsafePerformIO (unsafeLookupStaticPtr ptr) of
        Just value -> deRefStaticPtr value :: Get Foo
        Nothing -> error "Binary Foo: unknown static pointer"

  put :: Foo -> Put
  put (Foo (a :: bob)) = do
    put $ staticKey $ static (get :: Get bob)
    put a