Create a gist now

Instantly share code, notes, and snippets.

Embed
What would you like to do?
Binary existentials
{-# 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"
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment