[Haskell-cafe] Hint and Ambiguous Type issue
Daniel Gorín
dgorin at dc.uba.ar
Thu Mar 5 23:13:16 EST 2009
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>
More information about the Haskell-Cafe
mailing list