Thanks all of your for your time and your interesting examples. Now I can see that my problem is parsing a String. I am new in Haskell, so, I start to study parsing and how to create a parser from beginning.

I start with an example from the book as follows:
%The parser item fails if the input is empty and consumes the first character otherwise.

\begin{code}
newtype Parser a = Parser(String -> [(a, String)])

item::Parser Char
item = Parser(\cs -> case cs of
        ""     -> []
        (c:cs) -> [(c,cs)])

parse :: Parser a -> String -> [(a, String)]
parse p cs = p cs
\end{code}

and I compile, the error displays. I do not know how to fix it. Please help me.

$ghci parser.lhs
parser.lhs:10:13:
    Couldn't match `Parser a' against `t -> t1'
      Expected type: Parser a
      Inferred type: t -> t1
    Probable cause: `p' is applied to too many arguments in the call (p cs)
    In the definition of `parse': parse p cs = p cs
Failed, modules loaded: none.



On 10/14/05, Ralf Hinze <ralf@informatik.uni-bonn.de> wrote:
Hi Huong,

attached you find a small program for parsing values of various (data)
types. It uses a generalized algebraic data type for representing types
and a universal data type for representing values. The parser itself is
rather simple-minded: it builds on Haskell's "ReadS" type.

I don't know whether this is what you are after, but it was fun writing.
There are many opportunities for improvement: one could use a decent
combinator library for parsing; a type of dynamic values instead of a
universal type etc.

Here are some example calls:

Main> parseAny "4711"
[(ValInt 4711,"")]
Main> parseAny "\"4711\""
[(ValString "4711","")]
Main> parseAny "[4711, 0]"
[(ValList [ValInt 4711,ValInt 0],"")]
Main> parseAny "[4711, 'a']"
[(ValList [ValInt 4711,ValChar 'a'],"")]
Main> parseAny "[\"hello world\"]"
[(ValList [ValString "hello world"],"")]

Note that "parseAny" even parses heterogenous lists.

Cheers, Ralf

---

> {-# OPTIONS -fglasgow-exts #-}

> data Type :: * -> * where
>   Char    :: Type Char
>   Int     :: Type Int
>   List    :: Type a -> Type [a]
>   Value   :: Type Value

> string :: Type String
> string  =  List Char

> parse :: Type t -> ReadS t
> parse (Char)       =  reads
> parse (Int)        =  reads
> parse (List Char)  =  reads
> parse (List a)     =  parseList (parse (a))
> parse (Value)      =  parseAny

> data Value
>   =  ValChar    Char
>   |  ValInt     Int
>   |  ValString  String
>   |  ValList    [Value]
>   deriving (Show)

> parseAny
>   =   ValChar   <$> parse Char
>   <+> ValInt    <$> parse Int
>   <+> ValString <$> parse string
>   <+> ValList   <$> parse (List Value)

Helper functions.

> parseList parsea
>   =  readParen False (\ s -> [ xs | ("[", t) <- lex s, xs <- parsel t ])
>   where parsel  s  =   [ ([],     t) | ("]", t) <- lex s ]
>                    ++  [ (x : xs, u) | (x,   t) <- parsea s,
>                                        (xs,  u) <- parsel' t ]
>         parsel' s  =   [ ([],     t) | ("]", t) <- lex s ]
>                    ++  [ (x : xs, v) | (",", t) <- lex s,
>                                        (x,   u) <- parsea t,
>                                        (xs,  v) <- parsel' u]

> infix  8  <$>
> infixr 6  <+>
> (f <$> p) s  =  [ (f a, t) | (a, t) <- p s ]
> (p <+> q) s  =  p s ++ q s