Binary existentials

Binary.hs

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

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

data Foo = forall a . (StaticFoo a, Binary a, Show a) => Foo a

class StaticFoo a where
    staticFoo :: a -> StaticPtr (Get Foo)

instance StaticFoo String where
    staticFoo _ = static (Foo <$> (get :: Get String))

instance StaticFoo Int where
    staticFoo _ = static (Foo <$> (get :: Get Int))
   

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

instance Binary Foo where
    put :: Foo -> Put
    put (Foo x) = do
        put $ staticKey $ staticFoo x
        put x

    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"