wuxb
wuxb

Reputation: 2612

Missing instance errors, module loading and GHCi

it came from another question, but things has changed.

The type signature of Parsec function 'parse' and the class 'Stream'

I'm now wondering what does import do to make things different.


file:RunParse.hs

module RunParse where
import System.IO
import Data.Functor.Identity (Identity)
----import Text.Parsec ()     ....................(1)
----import Text.Parsec        ....................(2)
import Text.Parsec.Prim (Parsec, parse, Stream)

runIOParse :: (Show a) => Parsec String () a -> String -> IO ()
runIOParse pa fn =
  do
    inh <- openFile fn ReadMode
    outh <- openFile (fn ++ ".parseout") WriteMode
    instr <- hGetContents inh
    let result = case parse pa fn instr of
                   Right rs -> show rs
                   Left err -> "error"
    hPutStr outh result
    hClose inh
    hClose outh

(I'm using ghc 7.0.4)

load the file into ghci:

> :l RunParse.hs

it tells me:


RunParse.hs:13:23:
Could not deduce (Stream String Identity t0)
  arising from a use of `parse'
from the context (Show a)
  bound by the type signature for
             runIOParse :: Show a => Parsec String () a -> String -> IO ()
  at RunParse.hs:(8,1)-(18,15)
Possible fix:
  add (Stream String Identity t0) to the context of
    the type signature for
      runIOParse :: Show a => Parsec String () a -> String -> IO ()
  or add an instance declaration for (Stream String Identity t0)
In the expression: parse pa fn instr
In the expression:
  case parse pa fn instr of {
    Right rs -> show rs
    Left err -> "error" }
In an equation for `result':
    result
      = case parse pa fn instr of {
          Right rs -> show rs
          Left err -> "error" }

then I added either (1) or (2):

import Text.Parsec ()     ....................(1)
import Text.Parsec        ....................(2)

Then :l RunParse , load succeeded.

Then I remove all of (1) and (2), then :l RunParse, still succeeded!

Then I :q quit the ghci, restart ghci, just same as the start, it failed to load.

Does this is a bug of ghc, or I should know more about import?

P.S. RunParse.hs failed the ghc -c --make RunParse.hs without (1) and (2).

Upvotes: 4

Views: 441

Answers (1)

Mikhail Glushenkov
Mikhail Glushenkov

Reputation: 15078

The error message tells you that the compiler can't find an instance declaration for Stream String Identity t0. This instance is defined in Text.Parsec.String:

instance (Monad m) => Stream [tok] m tok where
    uncons []     = return $ Nothing
    uncons (t:ts) = return $ Just (t,ts)

Importing Text.Parsec brings the Stream instance from Text.Parsec.String in scope and makes your code compile. Changing import Text.Parsec() to just import Text.Parsec.String() will also fix this error.

Your problem with code not loading after restarting GHCi is a known issue. GHCi doesn't do a very good job of controlling the scope of instance declarations. So after you have loaded a module once, instance declarations from it stay in scope for the rest of the session. That's why GHCi didn't complain after you removed the import Text.Parsec () line.

Upvotes: 5

Related Questions