Re: [Haskell-cafe] type signature of parsec functions and how to warp them up.

2011-06-16 Thread Brandon Allbery
On Fri, Jun 17, 2011 at 02:19, 吴兴博  wrote:
> I also tried to use 'import Text.Parsec ()'
> It works, now I'm wondering does '()' really hide everything.

You just confirmed that it's instances being imported; instances are
global and cannot be hidden, so "import Module ()" imports all of the
instances defined in Module but none of the functions.

-- 
brandon s allbery                                      allber...@gmail.com
wandering unix systems administrator (available)     (412) 475-9364 vm/sms

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


Re: [Haskell-cafe] type signature of parsec functions and how to warp them up.

2011-06-16 Thread Ivan Lazar Miljenovic
On 17 June 2011 16:19, 吴兴博  wrote:
> I also tried to use 'import Text.Parsec ()'
> It works, now I'm wondering does '()' really hide everything.

Everything except type class instances.


-- 
Ivan Lazar Miljenovic
ivan.miljeno...@gmail.com
IvanMiljenovic.wordpress.com

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


Re: [Haskell-cafe] type signature of parsec functions and how to warp them up.

2011-06-16 Thread 吴兴博
I also tried to use 'import Text.Parsec ()'
It works, now I'm wondering does '()' really hide everything.

2011/6/17 Brandon Allbery :
> I think the usual cause of that is that one or more necessary
> typeclass instances got defined by the import.
>
> --
> brandon s allbery                                      allber...@gmail.com
> wandering unix systems administrator (available)     (412) 475-9364 vm/sms
>



-- 

吴兴博  Wu Xingbo

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


Re: [Haskell-cafe] type signature of parsec functions and how to warp them up.

2011-06-16 Thread Brandon Allbery
On Fri, Jun 17, 2011 at 01:53, 吴兴博  wrote:
> I just add one line of import and ghci:
>
> import Text.Parsec
>
> then ghci loaded it succeed!
>
> It seems I didn't uses any functions from this import.
>
> what goes wrong?

I think the usual cause of that is that one or more necessary
typeclass instances got defined by the import.

-- 
brandon s allbery                                      allber...@gmail.com
wandering unix systems administrator (available)     (412) 475-9364 vm/sms

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


Re: [Haskell-cafe] type signature of parsec functions and how to warp them up.

2011-06-16 Thread 吴兴博
It seems weird:

first ghci failed to load this file:
file: RunParse.hs
---
module RunParse where
import System.IO
import Data.Functor.Identity (Identity)
import Text.Parsec first, no this
line---what about this line ???
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
--

ghci tell 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 Sim/Std/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" }
--



I just add one line of import and ghci:

import Text.Parsec

then ghci loaded it succeed!

It seems I didn't uses any functions from this import.

what goes wrong?


2011/6/17 吴兴博 :
> I have some different parsers of Parsec to use in a project, and I
> want to make a warp function to make the testing easy.




-- 

吴兴博  Wu Xingbo

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


[Haskell-cafe] type signature of parsec functions and how to warp them up.

2011-06-16 Thread 吴兴博
I have some different parsers of Parsec to use in a project, and I
want to make a warp function to make the testing easy.

here is some of my body of parser : they all has type of "parsecT ***"
  stringSet :: ParsecT  String  u  Identity  [String]
  intSet  ::  ParsecT  String  u  Identity  [Integer]
  tupleSet ::  ParsecT  String  u  Identity  [(String, String)]

all of the returned type are instance of 'Show'.

then I write these warp function:
--
import System.IO
import Data.Functor.Identity (Identity)
import Text.Parsec.Prim (ParsecT, runParserT, parse, Stream)
runIOParse :: (Show a) => ParsecT String u Identity a -> String -> IO ()
runIOParse pa fn =
  do
inh <- openFile fn ReadMode
outh <- openFile (fn ++ ".parseout") WriteMode
instr <- hGetContents inh
let result = show $ parse pa fn instr
hPutStr outh result
hClose inh
hClose outh
---
> :l RunParse.hs
---
RunParse.hs:12:31:
Could not deduce (u ~ ())
from the context (Show a)
  bound by the type signature for
 runIOParse :: Show a =>
   ParsecT String u Identity a -> String -> IO ()
  at RunParse.hs:(7,1)-(15,15)
  `u' is a rigid type variable bound by
  the type signature for
runIOParse :: Show a =>
  ParsecT String u Identity a -> String -> IO ()
  at RunParse.hs:7:1
Expected type: Text.Parsec.Prim.Parsec String () a
  Actual type: ParsecT String u Identity a
In the first argument of `parse', namely `pa'
In the second argument of `($)', namely `parse pa fn instr'
Failed, modules loaded: none.
---

then I modify the type signature of 'runIOParse':
runIOParse :: (Show a) => ParsecT String () Identity a -> String -> IO ()
then load again
> :l RunParse.hs
---
RunParse.hs:12:25:
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 =>
   ParsecT String () Identity a -> String -> IO ()
  at RunParse.hs:(7,1)-(15,15)
Possible fix:
  add (Stream String Identity t0) to the context of
the type signature for
  runIOParse :: Show a =>
ParsecT String () Identity a -> String -> IO ()
  or add an instance declaration for (Stream String Identity t0)
In the second argument of `($)', namely `parse pa fn instr'
In the expression: show $ parse pa fn instr
In an equation for `result': result = show $ parse pa fn instr
Failed, modules loaded: none.
---

I also tried some 'possible fix' in the information, but it still
failed to pass the compiler.

Main Question:
  How can I warp a parsec function interface for do the IO test
with different 'ParsecT String u Identity a'?

-- 

吴兴博  Wu Xingbo

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