[Haskell-beginners] Haskell wants the type, but I only know the class.

aditya siram aditya.siram at gmail.com
Fri Nov 4 14:52:36 CET 2011


Perhaps this is what you're looking for:
{-# LANGUAGE ExistentialQuantification #-}
import Data.Binary
import Data.ByteString.Lazy as B ( readFile, writeFile )
import Codec.Compression.GZip ( compress, decompress )

data Thing = forall a. (Binary a, Show a, Eq a) => Thing a

instance Binary Thing where
    get = get
    put (Thing a) = put a

instance Show Thing where
    show (Thing a) = show a

readThing :: FilePath -> IO Thing
readThing f = return . decode . decompress =<< B.readFile
f

writeThing :: FilePath -> Thing -> IO ()
writeThing f = B.writeFile f . compress . encode

doSomething :: Thing -> m Thing
doSomething = undefined

main = do
 a <- readThing "file1.txt"
 a' <- doSomething a
 writeThing "file2.txt" a'

It compiles on my machine (GHC 7.2.1) but I haven't tested it. It uses the
existential quantification extension to constrain a datatype to the
typeclasses you mention. The caveat is that the only functions you can run
on "a" or "a'" are those defined by the Eq, Show and Binary typeclasses.
-deech

On Fri, Nov 4, 2011 at 8:26 AM, Antoine Latter <aslatter at gmail.com> wrote:

> On Fri, Nov 4, 2011 at 7:51 AM, Amy de Buitléir <amy at nualeargais.ie>
> wrote:
> > Antoine Latter <aslatter <at> gmail.com> writes:
> >
> >> A really simple and common way to do this would be using a sum-type:
> >
> > Here's what I'm trying to accomplish. I want to write a daemon that will
> cycle
> > through the files, load each one in turn, and invoke the doSomething
> method. I
> > would like to be able to allow people to use my daemon with any
> assortment of new
> > types that they create, as long as that type implements the doSomething,
> > readThing, and writeThing methods.
> >
> > I could make the sum-type approach work, but then users would have to
> modify the
> > type. And there might be dozens of different types in use, some provided
> by me,
> > and some provided by the user, so it would get messy. But I might have
> to go
> > with that approach.
> >
>
> An executable, once compiled, cannot really learn about new types
> without dynamically loading new object code. Which is possible but
> often tricky.
>
> You'd have this problem in other languages, too, except Java and .Net
> have spent a lot of time working on the dynamic loading of new object
> code into a running process (but you would still need to get the
> .class file or .dll into a folder where the executable can read it).
>
> Maybe I'm mis-understanding your requirements, though.
>
> Antoine
>
> _______________________________________________
> Beginners mailing list
> Beginners at haskell.org
> http://www.haskell.org/mailman/listinfo/beginners
>
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://www.haskell.org/pipermail/beginners/attachments/20111104/9fe21d62/attachment.htm>


More information about the Beginners mailing list