How to derive instance for type without exported constructor?
In System.Random StdGen is defined as data StdGen = StdGen Int32 Int32 but its constructor StdGen is not exported. How to make StdGen to be an instance of Binary? The following won't work: instance Data.Binary.Binary StdGen where put (StdGen aa ab) = do Data.Binary.put aa Data.Binary.put ab get = do aa <- get ab <- get return (StdGen aa ab)
Well, normally - you can't (unless there is some equivalent to the constructor exported). But there is a trick. You can use generic classes: {-# OPTIONS_GHC -fglasgow-exts -XGenerics -package lang #-} import Generics class Binary' a where put' :: a -> Put get' :: Get a put' {| Unit |} Unit = return () get' {| Unit |} = return Unit put' {| a :+: b |} (Inl x) = putWord8 0 >> put' x put' {| a :+: b |} (Inr y) = putWord8 1 >> put' y get' {| a :+: b |} = do w <- getWord8 case w of 0 -> liftM Left get' _ -> liftM Right get' put' {| a :*: b |} (x :*: y) = put' x >> put' y get' {| a :*: b |} = do x <- get' y <- get' return $ x :*: y instance Binary' Int32 where put' = put get' = get instance Binary' StdGen instance Binary StdGen where put = put' get = get' Last time I've checked it worked fine. A friend of mine have used it to create "instance Eq Chan", if I remember correctly. Grigory Sarnitskiy wrote:
In System.Random StdGen is defined as
data StdGen = StdGen Int32 Int32
but its constructor StdGen is not exported. How to make StdGen to be an instance of Binary? The following won't work:
instance Data.Binary.Binary StdGen where put (StdGen aa ab) = do Data.Binary.put aa Data.Binary.put ab get = do aa <- get ab <- get return (StdGen aa ab) _______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe
{-# OPTIONS_GHC -fglasgow-exts -XGenerics -package lang #-}
Got some problems: Could not find module `Generics': it is a member of package ghc-6.8.2, which is hidden Failed, modules loaded: none. and for ghci test.hs -fglasgow-exts -XGenerics -package lang ghc-6.8.2: unknown package: lang
You're right. The issue you've mentioned can be fixed easily - import Data.Generics instead of Generics and get rid of -package lang (I've copied them from the documentation without checking, seems like it's a bit outdated). The real problem is that you can't use "Get a" in generics! And you have the same problem here, because "Get" constructor isn't exported either! But we can make it work using a continuation trick: {-# OPTIONS_GHC -fglasgow-exts -XGenerics #-} module Test where import Control.Monad import Data.Binary import Data.Generics import Data.Int import System.Random class Binary' a where put' :: a -> Put get' :: (a -> Get StdGen) -> Get StdGen put' {| Unit |} Unit = return () get' {| Unit |} f = f Unit put' {| a :+: b |} (Inl x) = putWord8 0 >> put' x put' {| a :+: b |} (Inr y) = putWord8 1 >> put' y get' {| a :+: b |} f = do w <- getWord8 case w of 0 -> get' $ \x -> f $ Inl x _ -> get' $ \y -> f $ Inr y put' {| a :*: b |} (x :*: y) = put' x >> put' y get' {| a :*: b |} f = get' $ \x -> get' $ \y -> f (x :*: y) instance Binary' Int32 where put' = put get' f = get >>= f instance Binary' StdGen instance Binary StdGen where put = put' get = get' return This time I've checked that it really compiles. Pretty much sure it works.
This time I've checked that it really compiles. Pretty much sure it works.
But how?! I'can't compile it: test.hs:11:2: Conflicting definitions for `put'' Bound at: test.hs:11:2-5 test.hs:13:2-5 test.hs:20:2-5 In the default-methods for class Binary' test.hs:12:2: Conflicting definitions for `get'' Bound at: test.hs:12:2-5 test.hs:15:2-5 test.hs:21:2-5 In the default-methods for class Binary'
Just copypasted it from my own email. Works fine. On 4 Sep 2009, at 20:05, Grigory Sarnitskiy wrote:
This time I've checked that it really compiles. Pretty much sure it works.
But how?! I'can't compile it:
test.hs:11:2: Conflicting definitions for `put'' Bound at: test.hs:11:2-5 test.hs:13:2-5 test.hs:20:2-5 In the default-methods for class Binary'
test.hs:12:2: Conflicting definitions for `get'' Bound at: test.hs:12:2-5 test.hs:15:2-5 test.hs:21:2-5 In the default-methods for class Binary' _______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe
Miguel Mitrofanov wrote:
Well, normally - you can't (unless there is some equivalent to the constructor exported).
But there is a trick. You can use generic classes:
{-# OPTIONS_GHC -fglasgow-exts -XGenerics -package lang #-} import Generics class Binary' a where put' :: a -> Put get' :: Get a put' {| Unit |} Unit = return () get' {| Unit |} = return Unit put' {| a :+: b |} (Inl x) = putWord8 0 >> put' x put' {| a :+: b |} (Inr y) = putWord8 1 >> put' y get' {| a :+: b |} = do w <- getWord8 case w of 0 -> liftM Left get' _ -> liftM Right get' put' {| a :*: b |} (x :*: y) = put' x >> put' y get' {| a :*: b |} = do x <- get' y <- get' return $ x :*: y instance Binary' Int32 where put' = put get' = get instance Binary' StdGen instance Binary StdGen where put = put' get = get'
Isn't it to define an isomorphic type and unsafeCoerce to it pretty much equivalent? At least the following simplest example works just fine: module Main where import Unsafe.Coerce class Test a where test :: a -> Int data Foo = Foo Int Int data Bar = Bar Int Int instance Test Bar where test (Bar a b) = a + b instance Test Foo where test foo = test (unsafeCoerce foo :: Bar) main :: IO () main = print $ test (Foo 123 345) Cheers, Kyra
Well, I've managed to produce a solution, quite ugly and unefficient. Still it works (and I really need it). StdGen serialization occurs only once during computation that lasts several hours, so the speed is not vital for me. Here is my solution: module Main where import System.Random import Data.Binary import Data.Int data StdGen' = StdGen' Int32 Int32 deriving (Show) gen2gen' :: StdGen -> StdGen' gen2gen' gen = let [g1, g2] = words $ show $ gen g1' = read g1 :: Int32 g2' = read g2 :: Int32 in StdGen' g1' g2' gen'2gen :: StdGen' -> StdGen gen'2gen (StdGen' g1' g2') = let gen = read $ show g1' ++ ' ':(show g2') :: StdGen in gen instance Data.Binary.Binary StdGen' where put (StdGen' aa ab) = do Data.Binary.put aa Data.Binary.put ab get = do aa <- get ab <- get return (StdGen' aa ab) instance Data.Binary.Binary StdGen where put gen = put $ gen2gen' gen get = do gen' <- get return (gen'2gen gen')
participants (3)
-
Grigory Sarnitskiy -
kyra -
Miguel Mitrofanov