[Haskell-cafe] How to write a polymorphic serializer?

[Li-yao Xia]

Hi Viktor,

This example is odd because it doesn't seem like the lock is doing anything.
Probably, the details that would make it more interesting have just been 
abstracted away, and I would guess that you do want a way to work with a 
single global lock.

A common pattern is that every MonadSomething type class (like 
Serializable here) comes with a SomethingT transformer providing the 
required environment.
In fact, this is a specialization of ReaderT/MonadReader.

     class Monad m => Serializable m where
       serially :: IO a -> m a

       default serially :: (m ~ t n, MonadTrans t, Serializable n) => IO 
a -> m a
       serially io = lift (serialize io)

     newtype SerializeT m a = SerializeT { runSerializeT :: MVar () -> m a }
     -- Monad instance

     instance MonadIO m => Serializable (SerializeT m) where
       serialize io = SerializeT (\lock -> liftIO (withMVar lock (const 
io)))

     instance Serializable m => Serializable (StateT s m)
     -- every other monad transformer where this makes sense

Keep foo and bar polymorphic, with MonadSomething constraints:

     -- No 'serially' argument
     foo :: (Serializable m, MonadIO m) => ... -> m ()
     foo ... = do
       ...
       serially $ ...

     bar :: (Serializable m, MonadState Int m) => ... -> m ()

You can compose foo and bar together so they are guaranteed to run under 
the same lock.

   baz :: (Serializable m, MonadState Int m, MonadIO m) => ... -> m ()
   baz ... ...  = do
     foo ...
     bar ...

To run an SerializeT action you still need to unwrap it explicitly, but 
just once, ensuring only one lock is used throughout the given action, 
and no user can mess with it as long as your types are abstract to them.

     serialize :: MonadIO m => SerializeT m a -> m a
     serialize m = do
       lock <- liftIO (newMVar ())
       runSerializeT m lock

     main :: IO ()
     main = evalStateT (serialize baz) 42

Now, if you are positive that you will only ever need a single lock, or 
you need synchronization even among distinct calls to `serialize` (which 
currently each generate a fresh lock), you can do this:

     -- Keep this out of the API.
-- Also notice this is *not* unsafeDupablePerformIO. We prevent a race 
condition on initialization.
     globalLock :: MVar ()
     globalLock = unsafePerformIO (newMVar ())

It is well known that unsafePerformIO requires extra care, but I believe 
that this situation is safe.

The main wart of unsafePerformIO is *unsoundness*: it allows you to 
derive unsafeCoerce :: forall a b. a -> b, and more generally it makes 
programs "go wrong".
However, as far as I can recall, this relies on an interaction between 
polymorphism and effects, the simplest example being to use 
unsafePerformIO to create a polymorphic MVar, put in a value of type a, 
take it out with type b.

Here it is being used at a single not-too-fancy ground type (MVar ()), 
so this doesn't seem to cause such problems.

     globalSerialize :: SerializeT m a -> m a
     globalSerialize m = runSerializeT m globalLock

Now that we have a global variable though, we might as well make a 
Serialize instance for IO.

     instance Serialize IO where
       serially io = withMVar globalLock (const io)

     main = flip evalStateT 42 $ do
       foo ...
       bar ... :: StateT Int IO ()

Regards,
Li-yao

On 09/15/2017 03:20 AM, Viktor Dukhovni wrote:
> I tried to implement a polymorphic serializer that uses a enclosed
> MVar () to serialize an action in an arbitrary IO monad, without
> a need for its user to resort to explicit liftIO calls.
>
> So, as a first step I create a typeclass that has a natural default
> implementation, and some instances for the Monads of interest that
> just use the natural default:
>
>      type Serially m = (MonadIO m) => forall a. IO a -> m a
>
>      class (MonadIO m) => Serializable m where
> 	serialize :: MVar () -> Serially m
> 	serialize lock = liftIO . withMVar lock . const
>
>      instance Serializable IO
>      instance Serializable (StateT Int IO)
>      ...
>
> With this, given:
>
> 	foo :: Serially IO -> ... -> IO ()
> 	foo serially ... = do
> 	    ...
> 	    serially $ ...
> 	    ...
>
> 	bar :: Serially (StateT Int IO) -> ... -> StateT Int IO ()
> 	bar serially ... = do
> 	    ...
> 	    serially $ ...
> 	    ...
>
> I can write:
>
> 	lock <- newMVar ()
> 	foo (serialize lock) ...
> 	bar (serialize lock)
>
> and the type system figures out the correct version of serialize
> for foo's and bar's actual monad.
>
> Is it possible to create a single "serialize lock" closure that
> works for both "foo" and "bar"?  Something that works along the
> lines of:
>
> 	let x = liftIO . withMVar lock . const :: ???
> 	foo x ...
> 	bar x ...
>
> If I leave out the "liftIO", then I can of course use:
>
>      x :: forall a. IO a -> IO a
>
> and the "liftIO" can be put explicitly into "foo" and "bar".
>
>      foo x ... = liftIO $ x $ ...
>      bar x ... = liftIO $ x $ ...
>
> but is it possible for "x" to both be polymorphic with respect to
> its user's monad and at the same time to be a *closure* around some
> MVar, and thus not directly a method of a type class.
>
> Of course needing to add an extra "liftI0" here and there is not
> onerous, I'm mostly just curious whether I'm missing something that
> can hide that boilerplate call in the serializer implementation.
>