Continuable and serializable parsers.

A pair of problems: 1) How to write a parser that could be restarted? Like, it will be represented by a function that returns something along the lines data ParseStepResult input result = Success (Maybe (input -> ParseStepResult input result)) (Maybe result) | Failure (ie, parsers using stream combinators like Fudgets have that property) ie, either a continuation of parsing process and result or failure flag. 2) How to write parser like one above that could be saved into database? data ParserCont input result = ... deriving (Show, Read) data ParseStepResult input result = Success (Maybe (ParserCont input result)) (Maybe result) | Failure I could imagine that it is possible using parser generator like Happy. Is it possible to get right using parsing combinators library?

Serguey Zefirov
1) How to write a parser that could be restarted? Like, it will be represented by a function that returns something along the lines
data ParseStepResult input result = Success (Maybe (input -> ParseStepResult input result)) (Maybe result) | Failure
(ie, parsers using stream combinators like Fudgets have that property) ie, either a continuation of parsing process and result or failure flag.
I think you're looking for `iteratees'. | newtype IterateeG c el m a | = IterateeG {runIter :: StreamG c el -> m (IterGV c el m a)} | | data IterGV c el m a | = Done a (StreamG c el) | Cont (IterateeG c el m a) (Maybe ErrMsg) | | data StreamG c el = EOF (Maybe ErrMsg) | Chunk (c el) See http://okmij.org/ftp/Streams.html http://hackage.haskell.org/package/iteratee See also http://www.haskell.org/haskellwiki/Enumerator_and_iteratee http://therning.org/magnus/archives/735/comment-page-1#comment-188128 http://comonad.com/reader/2009/iteratees-parsec-and-monoid/ http://inmachina.net/~jwlato/haskell/iter-audio/ -- vvv

2009/12/25 Valery V. Vorotyntsev
1) How to write a parser that could be restarted? Like, it will be represented by a function that returns something along the lines
data ParseStepResult input result = Success (Maybe (input -> ParseStepResult input result)) (Maybe result) | Failure
(ie, parsers using stream combinators like Fudgets have that property) ie, either a continuation of parsing process and result or failure flag.
I think you're looking for `iteratees'.
I am looking more for the way to serialize intermediate parser computations. The first problem is, actually, easy one. ;)

On Fri, Dec 25, 2009 at 11:25:41PM +0200, Serguey Zefirov wrote:
I am looking more for the way to serialize intermediate parser computations. The first problem is, actually, easy one. ;)
Probably you'll have to create a data constructor for each step of your parser. AFAIK, one of HAppS modules does a similar transformation via Template Haskell. The functions specify transactions, and each transaction is converted to a serializable data type. Then it's possible to create a transaction log by serializing them before their execution. Of course you could also modify Happy instead of writing a TH transformation. Both are preprocessor. TH would be more convenient, though. -- Felipe.

On Fri, Dec 25, 2009 at 4:55 PM, Felipe Lessa
On Fri, Dec 25, 2009 at 11:25:41PM +0200, Serguey Zefirov wrote:
I am looking more for the way to serialize intermediate parser computations. The first problem is, actually, easy one. ;)
Probably you'll have to create a data constructor for each step of your parser.
AFAIK, one of HAppS modules does a similar transformation via Template Haskell. The functions specify transactions, and each transaction is converted to a serializable data type. Then it's possible to create a transaction log by serializing them before their execution.
Of course you could also modify Happy instead of writing a TH transformation. Both are preprocessor. TH would be more convenient, though.
The happstack transaction serialization doesn't support higher-order types. Whether or not that's too much of a restriction depends on what you want your parsers to look like. Antoine

AFAIK, one of HAppS modules does a similar transformation via Template Haskell. The functions specify transactions, and each transaction is converted to a serializable data type. Then it's possible to create a transaction log by serializing them before their execution.
The happstack transaction serialization doesn't support higher-order types. Whether or not that's too much of a restriction depends on what you want your parsers to look like.
Higher-order like "data A m a = A (m a)"?

On Fri, Dec 25, 2009 at 5:06 PM, Serguey Zefirov
AFAIK, one of HAppS modules does a similar transformation via Template Haskell. The functions specify transactions, and each transaction is converted to a serializable data type. Then it's possible to create a transaction log by serializing them before their execution.
The happstack transaction serialization doesn't support higher-order types. Whether or not that's too much of a restriction depends on what you want your parsers to look like.
Higher-order like "data A m a = A (m a)"?
In that case, You'll be able to serialize that as long as you can serialize (m a). I meant higher-order as in function-types. So you wouldn't be able to serialize: string :: String -> Parser String Unless you had some way to reify the particular function to data. I'm also hazy on how you could encode a fully monadic expression - n applicative style parser may be a bit more modest. Antoine

On Fri, Dec 25, 2009 at 05:12:22PM -0500, Antoine Latter wrote:
In that case, You'll be able to serialize that as long as you can serialize (m a).
I meant higher-order as in function-types. So you wouldn't be able to serialize:
string :: String -> Parser String
Unless you had some way to reify the particular function to data.
That's the idea, to create something like data MyParser = FunString String | ... interpret :: MyParser -> Parser String interpret (FunString str) = string str However you're right in a sense, you can't use this scheme to serialize any functions taking functions, like something :: (a -> Parser a) -> a -> Parser a because data MyParser = FunSomething (a -> MyParser) a wouldn't be serializable. Well, maybe if your parsers were arrows... :) -- Felipe.

On Fri, Dec 25, 2009 at 8:31 PM, Felipe Lessa
However you're right in a sense, you can't use this scheme to serialize any functions taking functions, like
something :: (a -> Parser a) -> a -> Parser a
because
data MyParser = FunSomething (a -> MyParser) a
wouldn't be serializable. Well, maybe if your parsers were arrows... :)
You can't use full arrows because you need to be able to lift an arbitrary function into an arrow type, which precludes meeting the serialization criterion. You CAN use a CCC, but they are a bit harder to work with. =) http://hackage.haskell.org/packages/archive/category-extras/0.53.5/doc/html/... -Edward Kmett

On Sun, Dec 27, 2009 at 08:20:53AM -0500, Edward Kmett wrote:
On Fri, Dec 25, 2009 at 8:31 PM, Felipe Lessa
wrote: However you're right in a sense, you can't use this scheme to serialize any functions taking functions, like
something :: (a -> Parser a) -> a -> Parser a
because
data MyParser = FunSomething (a -> MyParser) a
wouldn't be serializable. Well, maybe if your parsers were arrows... :)
You can't use full arrows because you need to be able to lift an arbitrary function into an arrow type, which precludes meeting the serialization criterion.
Hmmm... but, assuming a preprocessor, you probably would be able to transform this code: number :: MyArrow String Int number = ... showMe :: MyArrow Int String showMe = ... doSomething :: Int -> Maybe Int doSomething = ... f = showMe . arr doSomething . number ...into this code: data Action a b where Number :: Action String Int ShowMe :: Action Int String ArrDoSomething :: Action Int (Maybe Int) (:*:) :: Action b c -> Action a b -> Action a c -- repeat definitions of number, showMe, doSomething f = ShowMe :*: ArrDoSomething :*: Number interpret :: Action a b -> MyArrow a b interpret Number = number interpret ShowMe = showMe interpret ArrDoSomething = arr doSomething interpret (f :*: g) = f . g instance Binary (Action a b) where put Number = putWord8 1 put ShowMe = putWord8 2 put ArrDoSomething = putWord8 3 put (f :*: g) = putWord8 4 >> put f >> put g get = do i <- getWord8 case i of 1 -> return Number 2 -> return ShowMe 3 -> return ArrDoSomething 4 -> (:*:) <$> get <*> get The only part missing here is being able to run only a small part of the arrow's computation and then return another Action. Is my example contrived? Am I missing something? :) Thanks! -- Felipe.

On Sun, Dec 27, 2009 at 8:59 AM, Felipe Lessa
Hmmm... but, assuming a preprocessor, you probably would be able to transform this code:
[snip]
The only part missing here is being able to run only a small part of the arrow's computation and then return another Action.
Is my example contrived? Am I missing something? :)
Assuming a sufficiently smart preprocessor you can do anything you'd like, but the result isn't an arrow. ;) -Edward Kmett

On Sun, Dec 27, 2009 at 09:34:54AM -0500, Edward Kmett wrote:
On Sun, Dec 27, 2009 at 8:59 AM, Felipe Lessa
wrote: Is my example contrived? Am I missing something? :)
Assuming a sufficiently smart preprocessor you can do anything you'd like, but the result isn't an arrow. ;)
Hehe, I see :). However I think this preprocessor would be feasible without too much effort. It would only replace arrow functions with data constructors, nothing really fancy. Well, perhaps I'm wrong. ;) -- Felipe.

2009/12/25 Felipe Lessa
I am looking more for the way to serialize intermediate parser computations. The first problem is, actually, easy one. ;)
Probably you'll have to create a data constructor for each step of your parser.
AFAIK, one of HAppS modules does a similar transformation via Template Haskell. The functions specify transactions, and each transaction is converted to a serializable data type. Then it's possible to create a transaction log by serializing them before their execution.
Of course you could also modify Happy instead of writing a TH transformation. Both are preprocessor. TH would be more convenient, though.
Thank you very much. I think, I will try Template Haskell approach, I prefer combinators over the generators.

On Fri, Dec 25, 2009 at 11:56 AM, Serguey Zefirov
A pair of problems: 1) How to write a parser that could be restarted? Like, it will be represented by a function that returns something along the lines
data ParseStepResult input result = Success (Maybe (input -> ParseStepResult input result)) (Maybe result) | Failure
This is basically the approach taken by the Iteratees package.
2) How to write parser like one above that could be saved into database?
data ParserCont input result = ... deriving (Show, Read) data ParseStepResult input result = Success (Maybe (ParserCont input result)) (Maybe result) | Failure
Yes, you'll have to defunctionalize the continuation , since you can't serialize an arbitrary function in Haskell.
I could imagine that it is possible using parser generator like Happy.
Is it possible to get right using parsing combinators library?
You won't find a built-in monadic parser combinator library that works this way, because of the necessary defunctionalization and the requirement that each action and intermediate result be serializable. You could probably encode the defunctionalization of a specific parser and build up a combinator set yourself, however. -Edward Kmett
_______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe
participants (5)
-
Antoine Latter
-
Edward Kmett
-
Felipe Lessa
-
Serguey Zefirov
-
Valery V. Vorotyntsev