Binary 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, Show a) => Foo (StaticPtr (Get Foo)) a

foo_string :: StaticPtr (Get Foo)
foo_string = static (Foo foo_string <$> (get :: Get String))

foo_int :: StaticPtr (Get Foo)
foo_int = static (Foo foo_int <$> (get :: Get Int))

main = do
    let a = encode $ Foo foo_string ("test" :: String)
    let b = encode $ Foo foo_int (123456 :: Int)
    let f s = case decode s of Foo _ x -> print 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 b) = do
    put $ staticKey a
    put b