[Haskell-cafe] Hint and Ambiguous Type issue
Joseph Fredette
jfredett at gmail.com
Fri Mar 6 12:10:50 EST 2009
Thanks so much, I think I understand. This definitely sounds like what I
want to do. I guess I've got some learning to do...
Thats why I love Haskell so much, every other day it gives me something
new to learn.
Thanks again,
/Joe
Daniel Gorín wrote:
> I think you can achieve what you want but you need to use the correct
> types for it. Remember that when you write:
>
> getFilterMainStuff :: Deliverable a => FilePath -> Interpreter (Path,
> Filter a)
>
> the proper way to read the signature is "the caller of
> getFilterMainStuff is entitled to pick the type of a, as long as it
> picks an instance of Deliverable". Contrast this with a method
> declaration in Java where:
>
> public Set getKeys()
>
> is to be read: "The invoked object may pick the type of the result, as
> long as it is a subclass of (or implements) Set".
>
> When you say that you want "to apply fMain to a (Config, Email) and
> get back a Deliverable a", I think you mean that fMain picks the type
> for a (and has to be an instance of Deliverable). There two ways to do
> this in Haskell:
>
> 1) You don't. If you know that your possible Deliverables are just
> FlatEmail and MaildirEmail, then the idiomatic way of doing this would
> be to turn Deliverable into an ADT:
>
> data Deliverable = FlatEmail .... | MaildirEmail .... deriving (Typeable)
> getFilterMainStuff :: FilePath -> Interpreter (Path, Filter Deliverable)
>
> 2) Existential types. If, for some reason, you need your "dynamic
> code" to be able to define new "deliverables", then you need to use
> the extension called "existential types".
>
> -- using GADT syntax
> data SomeDeliverable where Wrap :: Deliverable a => a -> SomeDeliverable
>
> getFilterMainStuff :: FilePath -> Interpreter (Path, Filter
> SomeDeliverable)
>
> This basically resembles the contract of the Java world: if you run
> fMain you will get a value of type SomeDeliverable; you can
> pattern-match it and will get something whose actual type you don't
> know, but that it is an instance of class Deliverable.
>
> See http://www.haskell.org/haskellwiki/Existential_type
>
> Good luck!
>
> Daniel
>
> On Mar 6, 2009, at 2:33 AM, Joseph Fredette wrote:
>
>> Okay, I think I understand... I got so hung up thinking the error had
>> to be in the Interpreter code, I didn't bother to look in the caller...
>>
>> But every answer breeds another question... The practical reason for
>> inferring fMain as being of type "Deliverable a => Filter a", is to
>> apply it (via runReader) to a (Config, Email) and get back a
>> Deliverable a, then to use the deliverIO method on the result -- my
>> question is, it appears I have to "know" the specific type of a in
>> order to get the thing to typecheck, but in order to use it, I need
>> to not know it...
>>
>> Perhaps, in fact, I'm doing this wrong. Thanks for the help Daniel,
>> everyone...
>>
>> /Joe
>>
>> Daniel Gorín wrote:
>>> Ok, so I've pulled the latest version and the error I get now is:
>>>
>>> Hackmain.hs:70:43:
>>> Ambiguous type variable `a' in the constraint:
>>> `Deliverable a'
>>> arising from a use of `getFilterMainStuff' at
>>> Hackmain.hs:70:43-60
>>> Probable fix: add a type signature that fixes these type variable(s)
>>>
>>> Function getFilterMainStuff compiles just fine . The offending line
>>> is in buildConf and reads:
>>>
>>> > (inboxL, fMain) <- runUnsafeInterpreter . getFilterMainStuff $
>>> filterMainL
>>>
>>> The problem is that GHC can't figure out the type of fMain. It
>>> infers (Filter a), but doesn't know what is a and therefore how to
>>> build a proper dictionary to pass to getFilterMainStuff.
>>>
>>> Observe that you would get a similar error message if you just defined:
>>>
>>> > f = show . read
>>>
>>> I can get it to compile by providing a type annotation for fMain:
>>>
>>> > (inboxL, fMain) <- runUnsafeInterpreter . getFilterMainStuff $
>>> filterMainL
>>> > let _ = fMain :: Filter MaildirEmail
>>>
>>> So once you use fMain somewhere and GHC can infer it's type,
>>> everything should work fine.
>>>
>>> Daniel
>>>
>>> On Mar 5, 2009, at 11:26 PM, Joseph Fredette wrote:
>>>
>>>> Oh, crap- I must have never pushed the latest patches, I did put
>>>> the typeable instances in all the appropriate places. And provided
>>>> a (maybe incorrect? Though I'm fairly sure that shouldn't affect
>>>> the bug I'm having now) Typeable implementation for Reader, but I
>>>> still get this ambiguous type. I'll push the current version asap.
>>>>
>>>> Thanks.
>>>>
>>>> /Joe
>>>>
>>>> Daniel Gorín wrote:
>>>>> Hi
>>>>>
>>>>> I've downloaded Hackmain from patch-tag, but I'm getting a
>>>>> different error. The error I get is:
>>>>>
>>>>> Hackmain.hs:63:10:
>>>>> No instance for (Data.Typeable.Typeable2
>>>>> Control.Monad.Reader.Reader)
>>>>> arising from a use of `interpret' at Hackmain.hs:63:10-67
>>>>>
>>>>> Hint requires the interpreted values to be an instance of Typeable
>>>>> in order to check, in runtime, that the interpreted value matches
>>>>> the type declared at compile. Therefore, you need to make sure
>>>>> that (Filter a) is indeed an instance of Typeable.
>>>>>
>>>>> Since you have Filter a = Reader (Config, Email) a, you probably
>>>>> need to
>>>>>
>>>>> - Derive Config and Email instances for Filter,
>>>>>
>>>>> - Manually provide Typeable instances for Reader a b, something
>>>>> along the lines of:
>>>>>
>>>>> instance (Typeable a, Typeable b) => Typeable (Reader a b) where...
>>>>>
>>>>> (I don't know why this isn't done in the mtl....)
>>>>>
>>>>> - Change the signature to:
>>>>>
>>>>> getFilterMain :: (Typeable a, Deliverable a) => FilePath ->
>>>>> Interpreter (Filter a)
>>>>>
>>>>> Also, you can try using "infer" instead of "as :: ...."
>>>>>
>>>>> Hope that helps
>>>>>
>>>>> Daniel
>>>>>
>>>>> On Mar 5, 2009, at 8:47 PM, Joseph Fredette wrote:
>>>>>
>>>>>> So, I tried both of those things, both each alone and together.
>>>>>> No dice. Same error, so I reverted back to the
>>>>>> original. :(
>>>>>> However, I was, after some random type signature insertions, able
>>>>>> to convert the problem into a different one, via:
>>>>>>
>>>>>> getFilterMain :: Deliverable a => FilePath -> Interpreter (Filter
>>>>>> a) getFilterMain MainLoc = do
>>>>>> loadModules [fMainLoc]; setTopLevelModules [(takeWhile
>>>>>> (/='.') fMainLoc)] fMain <-
>>>>>> (interpret "(filterMain)" infer)
>>>>>> return (fMain :: Deliverable a => Filter a)
>>>>>>
>>>>>> Inferred type is less polymorphic than expected
>>>>>> Quantified type variable `a' is mentioned in the environment:
>>>>>> fMain :: Filter a (bound at Hackmain.hs:77:1)
>>>>>> In the first argument of `return', namely
>>>>>> `(fMain :: (Deliverable a) => Filter a)'
>>>>>> In the expression: return (fMain :: (Deliverable a) => Filter a)
>>>>>> In the expression:
>>>>>> do loadModules [fMainLoc]
>>>>>> setTopLevelModules [(takeWhile (/= '.') fMainLoc)]
>>>>>> fMain <- (interpret "(filterMain)" infer)
>>>>>> return (fMain :: (Deliverable a) => Filter a)
>>>>>>
>>>>>> I'm thinking that this might be more easily solved -- I do think
>>>>>> I understand the issue. somehow, I need to tell the compiler
>>>>>> that the 'a' used in the return statement (return (fMain :: ...))
>>>>>> is the same as the 'a' in the type sig for the whole function.
>>>>>>
>>>>>> While I ponder this, and hopefully receive some more help --
>>>>>> thanks again Dan, Ryan -- Are there any other options besides
>>>>>> Hint that might -- at least in the short term -- make this
>>>>>> easier? I'd really like to finish this up. I'm _so_ close to
>>>>>> getting it done.
>>>>>>
>>>>>> Thanks,
>>>>>>
>>>>>> /Joe
>>>>>>
>>>>>> Ryan Ingram wrote:
>>>>>>> So, by using the Haskell interpreter, you're using the
>>>>>>> not-very-well-supported dynamically-typed subset of Haskell.
>>>>>>> You can
>>>>>>> tell this from the type signature of "interpret":
>>>>>>>
>>>>>>>
>>>>>>>> interpret :: Typeable a => String -> a -> Interpreter a
>>>>>>>>
>>>>>>>
>>>>>>>
>>>>>>>> as :: Typeable a => a
>>>>>>>> as = undefined
>>>>>>>>
>>>>>>>
>>>>>>> (from
>>>>>>> http://hackage.haskell.org/packages/archive/hint/0.2.1/doc/html/src/Language-Haskell-Interpreter-GHC.html)
>>>>>>>
>>>>>>>
>>>>>>> In particular, the "as" argument to interpret is specifying what
>>>>>>> type
>>>>>>> you want the interpreted result to be typechecked against; the
>>>>>>> interpretation fails if it doesn't match that type. But you
>>>>>>> need the
>>>>>>> result type to be an instance of Typeable; (forall a.
>>>>>>> Deliverable a =>
>>>>>>> Filter a) most certainly is not.
>>>>>>>
>>>>>>>
>>>>>>> Off the top of my head, you have a couple of directions you can
>>>>>>> take this.
>>>>>>>
>>>>>>> (1) Make Typeable a superclass of Deliverable, saying that all
>>>>>>> deliverable things must be dynamically typeable. Then derive
>>>>>>> Typeable
>>>>>>> on Filter, and have the result be of type "Filter a" using
>>>>>>> ScopedTypeVariables as suggested before. (You can also pass
>>>>>>> "infer" to
>>>>>>> the interpreter and let the compiler try to figure out the
>>>>>>> result type
>>>>>>> instead of passing (as :: SomeType).)
>>>>>>>
>>>>>>> (2) Make a newtype wrapper around Filter and give it an instance of
>>>>>>> Typeable, and add a constraint to filterMain that the result
>>>>>>> type in
>>>>>>> the filter is also typeable. Then unwrap the newtype after the
>>>>>>> interpreter completes.
>>>>>>>
>>>>>>> Good luck; I've never tried to use the Haskell interpreter
>>>>>>> before, so
>>>>>>> I'm curious how well it works and what problems you have with it!
>>>>>>>
>>>>>>>
>>>>>>> -- ryan
>>>>>>>
>>>>>>> 2009/3/5 Joseph Fredette <jfredett at gmail.com>:
>>>>>>>
>>>>>>>> I've been working on a little project, and one of the things I
>>>>>>>> need to do is
>>>>>>>> dynamically compile and import a Haskell Source file containing
>>>>>>>> filtering
>>>>>>>> definitions. I've written a small monad called Filter which is
>>>>>>>> simply:
>>>>>>>>
>>>>>>>> type Filter a = Reader (Config, Email) a
>>>>>>>>
>>>>>>>> To encompass all the email filtering. The method I need to import,
>>>>>>>> filterMain, has type:
>>>>>>>>
>>>>>>>> filterMain :: Deliverable a => Filter a
>>>>>>>>
>>>>>>>> where Deliverable is a type class which abstracts over delivery
>>>>>>>> to a path in
>>>>>>>> the file system. The notion is that I can write a type like:
>>>>>>>>
>>>>>>>> data DEmail = {email :: Email, path :: FilePath}
>>>>>>>> newtype Maildir = MD DEmail
>>>>>>>>
>>>>>>>> instance Deliverable Maildir where
>>>>>>>> {- ... omitted -}
>>>>>>>>
>>>>>>>> However, Filter a should not be restricted to Deliverable
>>>>>>>> types- it also
>>>>>>>> encompasses the results of regular expression matching, etc,
>>>>>>>> which are not
>>>>>>>> -- in general -- Deliverable instances.
>>>>>>>>
>>>>>>>> My question is this, when importing the file containing the
>>>>>>>> definitions of
>>>>>>>> filterMain, I have the following code to grab filterMain and
>>>>>>>> return it as a
>>>>>>>> function.
>>>>>>>>
>>>>>>>> getFilterMain :: Deliverable a => FilePath -> Interpreter
>>>>>>>> (Filter a)
>>>>>>>> getFilterMain fMainLoc = do
>>>>>>>> loadModules
>>>>>>>> [fMainLoc]; setTopLevelModules [(takeWhile (/='.') fMainLoc)]
>>>>>>>> fMain <- (interpret "(filterMain)" (as ::
>>>>>>>> Deliverable a
>>>>>>>> => Filter a)) return (fMain)
>>>>>>>>
>>>>>>>> However, when I try to
>>>>>>>> compile
>>>>>>>> this, I get the type error:
>>>>>>>>
>>>>>>>> Hackmain.hs:70:43:
>>>>>>>> Ambiguous type variable `a' in the constraint:
>>>>>>>> `Deliverable a'
>>>>>>>> arising from a use of `getFilterMainStuff' at
>>>>>>>> Hackmain.hs:70:43-60
>>>>>>>> Probable fix: add a type signature that fixes these type
>>>>>>>> variable(s)
>>>>>>>>
>>>>>>>> My understanding is that a type like "Foo a => Bar a" (where
>>>>>>>> Foo is a class
>>>>>>>> and Bar is a datatype) would simply restrict
>>>>>>>> the values of a to only those implementing Foo. But evidently
>>>>>>>> I'm wrong. Is
>>>>>>>> there a good (read, easy... :) ) fix to this?
>>>>>>>>
>>>>>>>> Any help would be greatly appreciated.
>>>>>>>>
>>>>>>>> /Joe
>>>>>>>>
>>>>>>>> PS. All the actual code is on patch-tag, here
>>>>>>>> http://patch-tag.com/repo/Hackmail/home -- if anyone prefers to
>>>>>>>> look at that
>>>>>>>> directly, the relevant files are in Src, namely, Hackmain.hs,
>>>>>>>> Filter.hs, and
>>>>>>>> Deliverable.hs
>>>>>>>>
>>>>>>>> _______________________________________________
>>>>>>>> Haskell-Cafe mailing list
>>>>>>>> Haskell-Cafe at haskell.org
>>>>>>>> http://www.haskell.org/mailman/listinfo/haskell-cafe
>>>>>>>>
>>>>>>>>
>>>>>>>>
>>>>>>>
>>>>>>>
>>>>>> <jfredett.vcf>_______________________________________________
>>>>>> Haskell-Cafe mailing list
>>>>>> Haskell-Cafe at haskell.org
>>>>>> http://www.haskell.org/mailman/listinfo/haskell-cafe
>>>>>
>>>>>
>>>> <jfredett.vcf>
>>>
>>>
>> <jfredett.vcf>
>
>
-------------- next part --------------
A non-text attachment was scrubbed...
Name: jfredett.vcf
Type: text/x-vcard
Size: 296 bytes
Desc: not available
Url : http://www.haskell.org/pipermail/haskell-cafe/attachments/20090306/6839c079/jfredett.vcf
More information about the Haskell-Cafe
mailing list