[Haskell-cafe] returning a polymorphic function

Patrick Chilton chpatrick at gmail.com
Mon Jun 15 16:42:04 UTC 2015


I've done something similar recently for an emulator I'm writing. It
essentially turns GHCI into a debugger for free:

newtype Run = Run (forall a. Emu a -> IO a)

start :: FilePath -> IO Run
breakpoint :: Word16 -> Emu ()
readMem :: Word16 -> Emu Word8
step :: Emu ()

Run emu <- start "foo.rom"
emu $ breakpoint 0x4567
emu $ readMem 0xdead
emu step

etc

On Mon, Jun 15, 2015 at 4:57 PM, Paolino <paolo.veronelli at gmail.com> wrote:

> It worked without adding JSON constraint in the newtype.
> I can do whatever I want with 'a'.
>
> A simplified example where the database module is not polluted with future
> use of the query results.
>
> http://lpaste.net/134541#a134548
>
>  I tried refactoring common code ...... not easy
>
> Thanks again
>
> paolino
>
> 2015-06-15 16:26 GMT+02:00 Paolino <paolo.veronelli at gmail.com>:
>
>> Thanks, I'd never have guessed.
>> I have a GADT Get a where I define a protocol to query a database where
>> 'a' is the return type a.
>> Then prepare :: IO (Get a -> ErrorAndWriterMonad a) is opening the
>> database and return the query function.
>> I suspect I have to insert the constraint in the wrapper to let transform
>> 'a' to JSON or String, which I don't like. I'll have to dig it.
>>
>> Regards
>>
>> paolino
>>
>>
>> 2015-06-15 16:18 GMT+02:00 Patrick Chilton <chpatrick at gmail.com>:
>>
>>> Yes, but you have to wrap it up:
>>>
>>> {-# LANGUAGE RankNTypes #-}
>>>
>>> -- obviously not to useful for this example :)
>>> newtype Id = Id (forall a. a -> a)
>>>
>>> f :: IO Id
>>> f = return (Id id)
>>>
>>> main = do
>>>   Id g <- f
>>>   print $ g 1
>>>   print $ g "ciao"
>>>
>>> Can I ask what you're trying to do with this?
>>>
>>> Patrick
>>>
>>> On Mon, Jun 15, 2015 at 3:11 PM, Paolino <paolo.veronelli at gmail.com>
>>> wrote:
>>>
>>>> Hello list, I'm trying to accomplish something along this line
>>>>
>>>> {-# LANGUAGE ScopedTypeVariables #-}
>>>>
>>>> f :: IO (a -> a)
>>>> f = return id
>>>>
>>>> main = do
>>>>   (g :: a -> a) <- f
>>>>   print $ g 1
>>>>   print $ g "ciao"
>>>>
>>>>
>>>>
>>>> Is it possible or I have to call f more than once to get different g's
>>>>
>>>>
>>>> Thanks
>>>>
>>>> paolino
>>>>
>>>> _______________________________________________
>>>> Haskell-Cafe mailing list
>>>> Haskell-Cafe at haskell.org
>>>> http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe
>>>>
>>>>
>>>
>>
>
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/haskell-cafe/attachments/20150615/38502cc6/attachment.html>


More information about the Haskell-Cafe mailing list