PROPOSAL: Some more 'Applicative' combinators

Hello, I propose that we add the following combinators to the 'Control.Applicative' module: skipMany :: (Alternative f) => f a -> f () skipMany p = skipSome p <|> pure () skipSome :: (Alternative f) => f a -> f () skipSome p = p *> skipMany p endBy :: (Alternative f) => f a -> f b -> f [a] endBy p s = many (p <* s) endBy1 :: (Alternative f) => f a -> f b -> f [a] endBy1 p s = some (p <* s) sepBy :: (Alternative f) => f a -> f v -> f [a] sepBy p s = sepBy1 p s <|> pure [] sepBy1 :: (Alternative f) => f a -> f v -> f [a] sepBy1 p s = (:) <$> p <*> many (s *> p) Any objections? Deadline for discussion is 2 weeks from now, which would be the 20th of Jan. -Iavor

Can you show some code fragments demonstrating how the combinators are used? I find it easier to understand the underlying concepts when I have not only the signature and implementation but an example of a typical use. It doesn't have to be working code, and it might even be pseudo code. (I'm not sure whether other Haskell folks feel the same way.)
On Sun, 6 Jan 2008 13:35:41 -0800
"Iavor Diatchki"
Hello, I propose that we add the following combinators to the 'Control.Applicative' module:
skipMany :: (Alternative f) => f a -> f () skipMany p = skipSome p <|> pure ()
skipSome :: (Alternative f) => f a -> f () skipSome p = p *> skipMany p
endBy :: (Alternative f) => f a -> f b -> f [a] endBy p s = many (p <* s)
endBy1 :: (Alternative f) => f a -> f b -> f [a] endBy1 p s = some (p <* s)
sepBy :: (Alternative f) => f a -> f v -> f [a] sepBy p s = sepBy1 p s <|> pure []
sepBy1 :: (Alternative f) => f a -> f v -> f [a] sepBy1 p s = (:) <$> p <*> many (s *> p)
Any objections? Deadline for discussion is 2 weeks from now, which would be the 20th of Jan.
-Iavor _______________________________________________ Libraries mailing list Libraries@haskell.org http://www.haskell.org/mailman/listinfo/libraries
--
Seth Kurtzberg

Hello, Sorry, I should have mentioned the origin of the combinators. These are (generalizations of) standard parser combinators, so think of "f a" in the type as a parser that can construct values of type "a". With this in mind, it should be more obvious what these combinators are used for. For example:
p `sepBy` sep is a parser that will return 0 or more occurances of 'p' separated by 'sep'. Many (all?) parser combinator libraries provide these functions, so having the generic 'Alternative' interface makes it easier to write parser that can work with different libraries. -Iavor
On Jan 6, 2008 3:34 PM, Seth Kurtzberg
Can you show some code fragments demonstrating how the combinators are used? I find it easier to understand the underlying concepts when I have not only the signature and implementation but an example of a typical use. It doesn't have to be working code, and it might even be pseudo code. (I'm not sure whether other Haskell folks feel the same way.)
On Sun, 6 Jan 2008 13:35:41 -0800 "Iavor Diatchki"
wrote: Hello, I propose that we add the following combinators to the 'Control.Applicative' module:
skipMany :: (Alternative f) => f a -> f () skipMany p = skipSome p <|> pure ()
skipSome :: (Alternative f) => f a -> f () skipSome p = p *> skipMany p
endBy :: (Alternative f) => f a -> f b -> f [a] endBy p s = many (p <* s)
endBy1 :: (Alternative f) => f a -> f b -> f [a] endBy1 p s = some (p <* s)
sepBy :: (Alternative f) => f a -> f v -> f [a] sepBy p s = sepBy1 p s <|> pure []
sepBy1 :: (Alternative f) => f a -> f v -> f [a] sepBy1 p s = (:) <$> p <*> many (s *> p)
Any objections? Deadline for discussion is 2 weeks from now, which would be the 20th of Jan.
-Iavor _______________________________________________ Libraries mailing list Libraries@haskell.org http://www.haskell.org/mailman/listinfo/libraries
-- Seth Kurtzberg
Hardware/Software/Driver Engineering

Iavor Diatchki wrote:
I propose that we add the following combinators to the 'Control.Applicative' module:
While applicative functors are good for this task, it would be a shame if the innocent reader of haddocks were to acquire the impression that parsing was all they were for. Why not make the task specificity clearer, with a separate Control.Applicative.Parsing module?

Hello,
On Jan 6, 2008 9:20 PM, Bryan O'Sullivan
While applicative functors are good for this task, it would be a shame if the innocent reader of haddocks were to acquire the impression that parsing was all they were for.
:-) oh, come on! I was just giving an example of what these combinators may be used for. They are not any more related to parsing than say, 'many', 'some', or 'empty' and '(<|>)'---they provide just a few more useful control structures.
Why not make the task specificity clearer, with a separate Control.Applicative.Parsing module?
Now _this_ would definitely suggest that they are only good for parsing which would be misleading. -Iavor

iavor.diatchki:
Hello,
On Jan 6, 2008 9:20 PM, Bryan O'Sullivan
wrote: While applicative functors are good for this task, it would be a shame if the innocent reader of haddocks were to acquire the impression that parsing was all they were for.
:-) oh, come on! I was just giving an example of what these combinators may be used for. They are not any more related to parsing than say, 'many', 'some', or 'empty' and '(<|>)'---they provide just a few more useful control structures.
Why not make the task specificity clearer, with a separate Control.Applicative.Parsing module?
Now _this_ would definitely suggest that they are only good for parsing which would be misleading.
+1 for this proposal. Glue for combining parsers seems like a missing piece. Perhaps toss in an example in the docs?

On Mon, Jan 07, 2008 at 04:53:14PM -0800, Don Stewart wrote:
iavor.diatchki:
Hello,
On Jan 6, 2008 9:20 PM, Bryan O'Sullivan
wrote: While applicative functors are good for this task, it would be a shame if the innocent reader of haddocks were to acquire the impression that parsing was all they were for.
:-) oh, come on! I was just giving an example of what these combinators may be used for. They are not any more related to parsing than say, 'many', 'some', or 'empty' and '(<|>)'---they provide just a few more useful control structures.
Why not make the task specificity clearer, with a separate Control.Applicative.Parsing module?
Now _this_ would definitely suggest that they are only good for parsing which would be misleading.
+1 for this proposal. Glue for combining parsers seems like a missing piece. Perhaps toss in an example in the docs?
Actually, there is a major issue with the current 'many', 'some' etc functions in Applicative. They arn't actually useful for applicative but non-monadic parsers! in fact, they lead to infinite loops! This is quite disturbing as statically analyzed parsers were part of the motivation of splitting out applicative. The reason is that it 'hides' the self-referential nature of the function in the recursive call directly so any routine attempting to analyze the parser will go around in circles. I think the solution would be either to get rid of many, etc.. or make them members of the type class. It is not even clear to me that just because something is a member of 'Alternative' that it has a natural, meaningful notion of repetition, so perhaps they belong in their own class. John -- John Meacham - ⑆repetae.net⑆john⑈

Iavor Diatchki wrote:
Bryan O'Sullivan wrote:
Why not make the task specificity clearer, with a separate Control.Applicative.Parsing module?
+1
Now _this_ would definitely suggest that they are only good for parsing which would be misleading.
Would it? I mean, I currently don't know a second use case for them. Preferably, the names like skipMany , endBy , sepBy etc. should still make sense in the new context. Regards, apfelmus

Hello,
On Jan 8, 2008 1:43 AM, apfelmus
Iavor Diatchki wrote:
Bryan O'Sullivan wrote:
Why not make the task specificity clearer, with a separate Control.Applicative.Parsing module?
+1
Now _this_ would definitely suggest that they are only good for parsing which would be misleading.
Would it? I mean, I currently don't know a second use case for them. Preferably, the names like skipMany , endBy , sepBy etc. should still make sense in the new context.
Yes it would. The name Control.Applicative.Parsing certainly suggests that. We should not overdo the granularity of the modules in the library. What would be the benefit of having a separate module? By the way, the combinators are all variations of 'many': 'skipMany' is just like 'many' but ignoring the results; 'endBy' performs a "cleanup" computation after each iteration; "sepBy" performs a "cleanup" operation between iterations. As I said before, these are just ordinary control structures. -Iavor

Bryan O'Sullivan wrote:
Why not make the task specificity clearer, with a separate Control.Applicative.Parsing module?
Iavor Diatchki wrote:
What would be the benefit of having a separate module?
Well, putting those combinators in Control.Applicative would suggest that applicative functors are for parsing only :)
By the way, the combinators are all variations of 'many': 'skipMany' is just like 'many' but ignoring the results; 'endBy' performs a "cleanup" computation after each iteration; "sepBy" performs a "cleanup" operation between iterations. As I said before, these are just ordinary control structures.
What I want to say is that I doubt that many and friends are general purpose. Is there an example of an applicative functor that is not a parser but for which many , skipMany and so on make sense / are useful? For [] and Maybe, both many [1] many $ Just 1 just give a stack overflow. Regards, apfelmus

Iavor wrote:
I propose that we add the following combinators to the 'Control.Applicative' module:
Here's a bunch, I've been using for quite some time now: infixl 5 <?>, <??>, <<?>, <?>> infixl 4 <$$>, <^>, <^, <^^>, , , <+> infixl 3 <||> infixl 2 `opt` (<$$>) :: (Applicative f) => f a -> (a -> b) -> f b v <$$> f = v <**> pure f (<^>) :: (Applicative f) => f (a -> b -> c) -> f b -> f (a -> c) l <^> r = flip <$> l <*> r (<^) :: (Applicative f) => f (a -> b -> c) -> f d -> f (b -> a -> c) l <^ r = flip <$> l <* r (<^^>) :: (Applicative f) => f b -> f (a -> b -> c) -> f (a -> c) l <^^> r = l <**> (flip <$> r) () :: (Applicative f) => (a -> b -> c) -> f b -> f (a -> c) f v = flip f <$> v ( (a -> b -> c) -> f d -> f (b -> a -> c) f ) :: (Applicative f) => f b -> (a -> b -> c) -> f (a -> c) v f = v <$$> flip f (<+>) :: (Applicative f) => f a -> f b -> f (a, b) l <+> r = (,) <$> l <*> r (<||>) :: (Alternative f) => f a -> f b -> f (Either a b) l <||> r = Left <$> l <|> Right <$> r (<?>) :: (Alternative f) => a -> f a -> f a x <?> v = v <|> pure x (<??>), opt :: (Alternative f) => f a -> a -> f a v <??> x = v <|> pure x opt = (<??>) (<<?>) :: (Alternative f) => f (a -> a) -> f a -> f a l <<?> r = id <?> l <*> r (<?>>) :: (Alternative f) => f a -> f (a -> a) -> f a l <?>> r = l <**> r <??> id packed :: (Applicative f) => f a -> f b -> f c -> f c packed l r v = l *> v <* r choice :: (Alternative f) => [f a] -> f a choice = foldr (<|>) empty foldrMany :: (Alternative f) => (a -> b -> b) -> b -> f a -> f b foldrMany op e v = go where go = op <$> v <*> go `opt` e foldrSome :: (Alternative f) => (a -> b -> b) -> b -> f a -> f b foldrSome op e v = op <$> v <*> go where go = op <$> v <*> go `opt` e foldlMany :: (Alternative f) => (b -> a -> b) -> b -> f a -> f b foldlMany op e v = go <*> pure e where go = op <!> v <!!> (.) <*> go `opt` id foldlSome :: (Alternative f) => (b -> a -> b) -> b -> f a -> f b foldlSome op e v = op e <$> v <**> go where go = op <!> v <!!> (.) <*> go `opt` id foldrSepMany :: (Alternative f) => (a -> b -> b) -> b -> f c -> f a -> f b foldrSepMany op e u v = op <$> v <*> go `opt` e where go = op <$ u <*> v <*> go `opt` e foldrSepSome :: (Alternative f) => (a -> b -> b) -> b -> f c -> f a -> f b foldrSepSome op e u v = op <$> v <*> go where go = op <$ u <*> v <*> go `opt` e foldlSepMany :: (Alternative f) => (b -> a -> b) -> b -> f c -> f a -> f b foldlSepMany op e u v = op e <$> v <**> go `opt` e where go = op <! u <*> v <!!> (.) <*> go `opt` id foldlSepSome :: (Alternative f) => (b -> a -> b) -> b -> f c -> f a -> f b foldlSepSome op e u v = op e <$> v <**> go where go = op <! u <*> v <!!> (.) <*> go `opt` id sepMany, sepSome :: (Alternative f) => f b -> f a -> f [a] sepMany = foldrSepMany (:) [] sepSome = foldrSepSome (:) [] chainr :: (Alternative f) => f (a -> a -> a) -> f a -> f a chainr u v = v <?>> go where go = u <^> v >> go chainl :: (Alternative f) => f (a -> a -> a) -> f a -> f a chainl u v = v <**> go where go = (.) (u <^> v) <*> go `opt` id Cheers, Stefan
participants (7)
-
apfelmus
-
Bryan O'Sullivan
-
Don Stewart
-
Iavor Diatchki
-
John Meacham
-
Seth Kurtzberg
-
Stefan Holdermans