9

Today I wanted to investigate if it is possible to construct a data type in such a way, that it does not store the data of the type of its type signature, but another representation of it. So, here is my attempt of an GADT which has a type constructor of type a, but a data constructor of type ByteString.

{-# LANGUAGE GADTs #-}
import Data.ByteString.Char8
import Data.Serialize

data Serialized a where
    MkSerialized :: (Serialize a) => ByteString -> Serialized a

Now I can define a decode' function in the following way:

decode' :: (Serialize a) => Serialized a -> a
decode' (MkSerialized bs) = let Right r = (decode bs) in r

And it works:

let s = MkSerialized (encode "test") :: Serialized String
print $ decode' s     -- prints "test"

My problem is now that I'd like Serialized to be an instance of Functor.

instance Functor Serialized where
    fmap f (MkSerialized bs) = MkSerialized (encode (f (right (decode bs))))
                               where right (Right r) = r

But I get the error (Serialize b) can not be deduced. How can I constraint the Functor instance so that Serialize is enforced in the fmap?

Phae7rae
  • 524
  • 2
  • 4
  • 14
  • 2
    You can't. `Functor` doesn't allow constraints on the type parameters to be required. There's a restricted functor class, [`RFunctor`](http://hackage.haskell.org/packages/archive/rmonad/0.8/doc/html/Control-RMonad.html#t:RFunctor) in the `rmonad` package. Maybe you can use that. – Daniel Fischer Jun 17 '13 at 22:05
  • 2
    This isn't related to your question -- this is indeed not possible with `Functor` -- but I feel obligated to mention: Please don't use `Data.ByteString.Char8` by default! It's a broken module that encourages broken code. There are some uses for it sometimes, but your code works just as well with `Data.ByteString`, which doesn't encourage misunderstandings of Unicode. – shachaf Jun 17 '13 at 22:42
  • 1
    For what it's worth, you can make a `CoYoneda`-style data type like `data Serialized a where MkSerialized :: Serialize x => ByteString -> (x -> a) -> Serialized a` which stores a ByteString and a post-deserialization function, and which does have a `Functor` instance. But of course that defeats the purpose here. – shachaf Jun 17 '13 at 22:45
  • 2
    This is closely related to the subject of Sculthorpe et al.'s paper ["The Constrained-Monad Problem"](http://www.ittc.ku.edu/csdl/fpg/papers/Sculthorpe-13-ConstrainedMonad.html). –  Jun 17 '13 at 22:51
  • I haven't thrown this onto Hackage yet, but the [Summit](https://github.com/RobotGymnast/Summit) library has a [Mappable class](https://github.com/RobotGymnast/Summit/blob/master/src/Prelewd.hs#LC161) which can be constrained on the Functor's parameter types, as well as on the Functor type itself. – bfops Jun 18 '13 at 19:05

1 Answers1

7

You can do this using a CoYoneda functor.

The idea is simple: have an additional functional field where you accumulate your fmaping functions. When you decode your value, then apply that function.

Here's the code:

{-# LANGUAGE GADTs #-}
import Data.ByteString.Char8
import Data.Serialize

data Serialized a where
    MkSerialized
      :: (Serialize a)
      => ByteString -> (a -> b) -> Serialized b

decode' :: Serialized a -> a
decode' (MkSerialized bs f) = let Right r = decode bs in f r

instance Functor Serialized where
    fmap f (MkSerialized bs g) = MkSerialized bs (f . g)

This also has the benefit of automatically fusing multiple fmaps instead of repeated decodings and encodings, as would be in your case.

Roman Cheplyaka
  • 37,738
  • 7
  • 72
  • 121
  • 2
    While this isn't really solving my problem (as I would've liked `fmap` to do repeated de-/encodings), I'll accept this answer b/c I see that my original idea is not possible and this is the most practical way to define a functor for a constrained GADT. Also, [interesting read for GADTs and Yoneda functors](http://www.haskellforall.com/2012/06/gadts.html). – Phae7rae Jun 20 '13 at 09:24