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