Function application layout

Hi, Would it be possible to allow this in Haskell (where <applied to> is some new operator or keyword): f <applied to> {x a;y b;z c} As an equivalent to: f (x a) (y b) (z c) Of course my intention is that the new keyword should initiate layout syntax so we can write this: f <applied to> x a y b z c In addition to the case where you have a big function application, this is useful for defining trees: Branch <applied to> Branch <applied to> Leaf Leaf Leaf Has something like this been suggested before? Are there any disadvantages other than a new keyword and some potential confusion for readers? Any suggestions for a good keyword? I suppose some variant of $ makes sense, a textual keyword like "with" would be nice but probably break a lot of code. Regards, Jonas

I don't see the similarity (from reading this:
http://www.haskell.org/haskellwiki/Idiom_brackets). My suggestion is
just a way of using layout to avoid parenthesis.
/J
2011/5/25 Brandon Allbery
2011/5/25 Jonas Almström Duregård
Would it be possible to allow this in Haskell (where <applied to> is some new operator or keyword): f <applied to> {x a;y b;z c}
Sounds like idiom brackets to me.

2011/5/25 Jonas Almström Duregård
I don't see the similarity (from reading this: http://www.haskell.org/haskellwiki/Idiom_brackets). My suggestion is just a way of using layout to avoid parenthesis.
This is "exactly" the applicative style, where idiom brackets come from. Use Control.Applicative: f <$> x a <*> y b <*> z c You can use the identity functor to recover "plain old" function application. Idiom brackets abstract the <$> (fmap) and (<*>) operators away. And yes, you are right that applicative style is very useful.

Hi Alexander,
This is "exactly" the applicative style, where idiom brackets come from.
I disagree. Layout has at least two advantages over applicative here: 1) Applicative costs (at least) three additional characters per function parameter. 2) You can not have arbitrary infix operators in the parameters when using applicative. Also your example is not really equivalent to f (x a) (y b) (z c) is it?
Idiom brackets abstract the <$> (fmap) and (<*>) operators away.
But from what I can tell it also reintroduces the parenthesis? How would you
write f (x a) (y b) in idiom brackets?
/J
On 25 May 2011 22:06, Alexander Solla
2011/5/25 Jonas Almström Duregård
I don't see the similarity (from reading this: http://www.haskell.org/haskellwiki/Idiom_brackets). My suggestion is just a way of using layout to avoid parenthesis.
This is "exactly" the applicative style, where idiom brackets come from. Use Control.Applicative: f <$> x a <*> y b <*> z c You can use the identity functor to recover "plain old" function application. Idiom brackets abstract the <$> (fmap) and (<*>) operators away. And yes, you are right that applicative style is very useful.

2011/5/25 Jonas Almström Duregård
Hi Alexander,
This is "exactly" the applicative style, where idiom brackets come from.
I disagree. Layout has at least two advantages over applicative here:
1) Applicative costs (at least) three additional characters per function parameter.
I don't think so. Presumably, you would replace them with spaces, if you were indenting to "tabular" form.
2) You can not have arbitrary infix operators in the parameters when using applicative.
True.
Also your example is not really equivalent to f (x a) (y b) (z c) is it?
It is up to isomorphism, if you use the identity functor: newtype Id a = Id { unId :: a } tryItOut :: Id Int tryItOut = (+) <$> 1 <*> 2
Idiom brackets abstract the <$> (fmap) and (<*>) operators away.
But from what I can tell it also reintroduces the parenthesis? How would you write f (x a) (y b) in idiom brackets?
I prefer the applicative style, so I would use that.
/J
On 25 May 2011 22:06, Alexander Solla
wrote: 2011/5/25 Jonas Almström Duregård
I don't see the similarity (from reading this: http://www.haskell.org/haskellwiki/Idiom_brackets). My suggestion is just a way of using layout to avoid parenthesis.
This is "exactly" the applicative style, where idiom brackets come from. Use Control.Applicative: f <$> x a <*> y b <*> z c You can use the identity functor to recover "plain old" function application. Idiom brackets abstract the <$> (fmap) and (<*>) operators away. And yes, you are right that applicative style is very useful.

On 25/05/11 10:00, Jonas Almström Duregård wrote:
As an equivalent to:
f (x a) (y b) (z c)
Of course my intention is that the new keyword should initiate layout syntax so we can write this:
f <applied to> x a y b z c
Here's a (tongue-in-cheek) trick that allows for layout close to what you wanted (spoiler: but not close enough!). We start by switching to parameterised monads (which allow you to change the type of the monad as you go down the do-block; look carefully at the second and third parameters in the monad class): {-# LANGUAGE RebindableSyntax #-}
import Control.Applicative import Prelude ((++), (.), Num(..), Eq(..), ($), id, Int, Char, String, Float, ?, const, Show(..), Fractional(..))
class Monad m where (>>=) :: m a b y -> (y -> m b c z) -> m a c z return :: b -> m a a b
(>>) :: Monad m => m a b y -> m b c z -> m a c z (>>) m n = m >>= const n
Then we define a type for wrapping pure functions in this monad:
data Fun a b c = Fun (a -> b) c
instance Monad Fun where (>>=) (Fun f x) m = let Fun g y = m x in Fun (g . f) y return x = Fun id x
Then we add a helper for unwrapping it:
($$) :: a -> Fun a b c -> b ($$) f (Fun g _) = g f
And a function for supplying an argument:
r :: a -> Fun (a -> b) b a r x = Fun ($ x) x
And so what does let us do? Well, here's how it's used:
foo :: Int -> Char -> String -> Float -> String foo a b c d = show (a, b, c, d)
eg :: String eg = foo $$ do r$ 2 + 1 r$ 'c' r$ "hello" ++ "goodbye" r$ 3.0
foo is the function we want to apply, and eg shows how to apply it in do-notation with an argument on each line. I couldn't manage to remove the r$ at the beginning of each line, which rather ruins the whole scheme :-( On the plus side, there's no brackets, it's only two extra characters per line, and you can have whatever you like after the r$. For those who are interested, you can also use the same trick for writing Applicatives in a do notation. Continuing the same module, we can add an analogue for each of the types and functions for Applicative:
data App f a b c = App (f a -> f b) c
instance Applicative f => Monad (App f) where (>>=) (App f x) m = let App g y = m x in App (g . f) y return x = App id x
(<$$>) :: Applicative f => f a -> App f a b c -> f b (<$$>) f (App g _) = g f
s :: Applicative f => f a -> App f (a -> b) b (f a) s x = App (<*> x) x
Then we can use this on things which are Applicative but not Monad, e.g.
egA :: [String] egA = getZipList $ pure foo <$$> do s$ ZipList [3, 6, 7] s$ ZipList "hello" s$ ZipList ["more", "strings"] s$ ZipList [1.0, 1.5, 2.0]
And that's enough silly playing around :-) Thanks, Neil.

On Thursday 26 May 2011 14:35:41, Neil Brown wrote:
foo is the function we want to apply, and eg shows how to apply it in do-notation with an argument on each line. I couldn't manage to remove the r$ at the beginning of each line, which rather ruins the whole scheme :-( On the plus side, there's no brackets, it's only two extra characters per line, and you can have whatever you like after the r$.
Wouldn't that be also achievable with infixl 0 ? (?) :: (a -> b) -> a -> b f ? x = f x eg = foo ? 2 + 1 ? 'c' ? "hello" ++ "goodbye" ? 3.0 ?

That's a useful operator! Unfortunately it does not play nice with $. Of
less importance: some syntactic constructs can not appear in the arguments
without parenthesis, let bindings for instance (although lambda abstraction
works parenthesis-free).
Also I'm not sure this can be used for defining trees or nested function
application since a nesting of the operator inevitably require parenthesis.
/J
On 26 May 2011 14:52, Daniel Fischer
On Thursday 26 May 2011 14:35:41, Neil Brown wrote:
foo is the function we want to apply, and eg shows how to apply it in do-notation with an argument on each line. I couldn't manage to remove the r$ at the beginning of each line, which rather ruins the whole scheme :-( On the plus side, there's no brackets, it's only two extra characters per line, and you can have whatever you like after the r$.
Wouldn't that be also achievable with
infixl 0 ?
(?) :: (a -> b) -> a -> b f ? x = f x
eg = foo ? 2 + 1 ? 'c' ? "hello" ++ "goodbye" ? 3.0
?
_______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe

On Thursday 26 May 2011 17:22:10, Jonas Almström Duregård wrote:
Unfortunately it does not play nice with $.
Yes.
Also I'm not sure this can be used for defining trees or nested function application since a nesting of the operator inevitably require parenthesis.
It can't be nested, like ($) can't be nested. You could however add infixl 1 ?? infixl 2 ??? ... to achieve the possibility of nesting (but you have to be careful with low- precedence operators if you actually want to use that). As far as I'm concerned, a left-associative version of ($) would sometimes be nice (on the other hand, right-associativity of ($) is sometimes also nice), but usually, I don't find parentheses too obnoxious.

2011/5/26 Daniel Fischer
As far as I'm concerned, a left-associative version of ($) would sometimes be nice (on the other hand, right-associativity of ($) is sometimes also nice), but usually, I don't find parentheses too obnoxious.
I have a whole set of function application/composition/lifting operators that I'm rather fond of, but it involves replacing some standard operators, and in particular changes the fixity of ($) drastically, so it's something I only use in small bits of personal code that I'll never publish anywhere. The main idea is that there are two groups of operators, each of which are internally pretty consistent and vaguely generalized from standard operators. Very low precedence, function application associates toward argument: f <| x = x |> f = f x, (>>>) and (<<<) for composition, and (>>=), (=<<), (>=>), and (<=<) behaving as expected. (<|) takes the place of standard ($), and (|>) allows a "pipe forward" style similar to using (>>=). Mid-to-high precedence, function application associates away from argument: ($) has the same fixity as (<$>) and (<*>), as do the binding operators (=<$) and (=<*), the latter being a function I haven't seen before that does about what you'd expect from the name. Composition is usually just (.) in most cases because of the style in which I use these. What it amounts to is that the first group is used mostly as pseudo-syntax delimiting expressions that would otherwise be parenthesized, while the second group is used for writing expressions that would conceptually be simple one-liners if not for involving lifting into some sort of Functor. The choice of symbols makes it easy to remember which is which, even if it's not perfectly consistent. Mostly, though, this is probably just another reason why my personal coding style would be bafflingly opaque to most people, so oh well. - C.
participants (6)
-
Alexander Solla
-
Brandon Allbery
-
Casey McCann
-
Daniel Fischer
-
Jonas Almström Duregård
-
Neil Brown