[Haskell-cafe] GHCi infers a type but refuses it as type signature

Eric papa.eric at free.fr
Mon Jun 22 20:02:25 EDT 2009


Hi haskell helpers,

I am new to haskell (but enthusiast).

I have begun to play with State and StateT, but this very simple
exercice has led me to a strange situation where GHCi recognises
and accepts the type of a function but GHC won't allow it as a
type signature. Here is the example (which is also a try at
literate haskell).

> import Control.Monad.State
>
> type Play = Char
> type Game = [Play]  -- a game is a series of plays  

Now, you play by issuing a char, and you win if you have played
an already played char. That was my first "play" function,
returning True if you win.

> play :: Play -> State Game Bool
> play p = do ps <- get
>             put (p:ps)
>             return $  p `elem` ps  

I tested this one this way:

> play_abc :: State Game Bool
> play_abc = do play 'a'
>               play 'b'
>               play 'c'
> 
> play_abca :: State Game Bool
> play_abca = play_abc >> play 'a'  

Now in GHCi,
"runState play_abc []"  yields (False, "cba")
"runState play_abca []" yields (True, "acba")

Good! I was happy, now trying StateT to add IO to get
console input:

> type IOGame = StateT Game IO
> 
> run_io :: IOGame Bool -> IO (Bool, Game)
> run_io x = runStateT x []  

Now I wanted a version of "play" that
reads a char, on the following model:

> play_once :: IOGame Bool
> play_once = do x <- liftIO getChar
>                play' x  

Of course I first tried to express play' using play, and failed.
Eventually I copied-and-pasted play, only changing the
type signature, and it worked:

> play' :: Play -> IOGame Bool
> play' x = do xs <- get
>              put (x:xs)
>              return $  x `elem` xs  

Now, on GHCi I was happy to type:
"run_io $ play_once"
or even
"run_io $ play_once >> play_once >> play_once"

However, how to avoid the code duplication?  I just tried
to remove the type signature, and yes, play2
suddenly works in both State Game and StateT Game IO: 

> play2 x = do xs <- get
>              put (x:xs)
>              return $  x `elem` xs
> 
> play2_abc :: State Game Bool
> play2_abc = play2 'a' >> play2 'b' >> play2 'c'
>
> play2_once :: IOGame Bool
> play2_once = do x <- liftIO getChar
>                 play2 x  

So what's the type of play2?

:t play2 yields:
(MonadState [a] m, Eq a) => a -> m Bool

Wow, nice, I get it now!
However if I try to add that type signature, or even the second,
more specific one below, ghci fails (signatures commented out
because of that):

> -- play3 :: (MonadState [a] m, Eq a) => a -> m Bool
> -- play3 :: (MonadState Game m) => Play -> m Bool
> play3 x = do xs <- get
>              put (x:xs)
>              return $  x `elem` xs  

It seems that an extension is required:

    Non type-variable argument in the constraint: MonadState [a] m
    (Use -XFlexibleContexts to permit this)
    In the type signature for `play3':
      play3 :: (MonadState [a] m, Eq a) => a -> m Bool

So how is it possible that GHCi can infer (and use) a type that you
cannot use as signature?

And is it really non standard to avoid such code duplication?
I was a bit surprised that such simple example should require a
compiler extension.

Thanks!

Eric


More information about the Haskell-Cafe mailing list