Hi Daniel, cafe,

On 31/03/12 17:47, Daniel Gorín wrote:
Could you provide a short example of the code you'd like to write but gives you 
problems? I'm not able to infer it from your workaround alone...

This problem originally came up on #haskell, where Rc43 had a problem making a library with a common module that re-exports several other modules:

http://hpaste.org/66281

My personal interest is somewhat secondary, having not yet used hint in a real project, but code I would like to write at some point in the future is much like the 'failure' below, unrolled it looks like:

main = (print =<<) . runInterpreter $ do
  setImports ["Prelude"]
  interpret "1/5" (as :: Rational)
-- fails

Having to remember that Rational is defined as type Rational = Ratio Integer and that Ratio is defined in Data.Ratio and then to add that to the setImports list is a little inconvenient:

main = (print =<<) . runInterpreter $ do
  setImports ["Prelude", "Data.Ratio" ]
  interpret "1/5" (as :: Rational)
-- works

But for my own purposes this is probably much saner in the long run than my newtype wrapping approach below.

However, this is not always possible: supposing Ratio itself was defined as a type synonym of Ratio2, and Ratio2 was not exported. Perhaps this is what Rc43 was experiencing, but I shouldn't speculate, as this is all getting a bit theoretical - I should try out hint in the real world to see if this problem makes things impractical for me - sorry for the noise!

Thanks,


Claude

Thanks,
Daniel


On Mar 31, 2012, at 6:19 PM, Claude Heiland-Allen wrote:

Hi all,

What's the recommended way to get hint[0] to play nice with type synonyms[1]?

A problem occurs with in scope type synonyms involving types not in scope.

I came up with this after looking at the source[2], but it makes me feel ill:

--8<--
-- hint and type synonyms don't play nice
module Main where

import Language.Haskell.Interpreter

import Data.Typeable as T
import Data.Typeable.Internal
import GHC.Fingerprint.Type

main = failure>>  success

test t = (print =<<) . runInterpreter $ do
  setImports [ "Prelude" ]
  interpret "1/5" t

failure = test (as :: Rational)
-- Left (WontCompile [GhcError {errMsg = "Not in scope: type constructor or class 
`Ratio'"}])

success = test (as :: Q)
-- Right (1 % 5)

newtype Q = Q Rational

instance Show Q where
  show (Q a) = show a
  showsPrec n (Q a) = showsPrec n a

instance Typeable Q where
  typeOf _ = TypeRep (Fingerprint 0 0) (T.mkTyCon "Rational") []
--8<--

Thanks,


Claude

[0] http://hackage.haskell.org/package/hint
[1] http://www.haskell.org/onlinereport/decls.html#type-synonym-decls
[2] 
http://hackage.haskell.org/packages/archive/hint/0.3.3.4/doc/html/src/Hint-Eval.html#interpret

_______________________________________________
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe



_______________________________________________
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe

Reply via email to