Type Level "Application" Operator

Elliot Cameron eacameron at gmail.com
Wed Nov 2 14:54:51 UTC 2016


Edward,

I had the exact same thought but I couldn't get it to work. Oddly enough, I
actually copied and pasted that example from my code which builds and runs
perfectly well. It seems that monad transformers work differently when
defined as a type (instead of newtype, which would require me to include
the type parameter)?

Somewhat related is the question of how to actually *export* this type
alias from a module.

> module Money (($)) where
>
> type f $ x = f x
> infixr 0 $

doesn't work because it tries to export Prelude.$. The only way around it
is to import Prelude hiding (($)). But this makes me wonder, is it actually
*impossible* in Haskell to export from the same module a function with the
same name at both the value and type level? Is it possible to export only
one of the two?

Elliot



On Wed, Nov 2, 2016 at 10:42 AM, Oleg Grenrus <oleg.grenrus at iki.fi> wrote:

> To make it clear:
>
> type level `.` won’t work as an type synonym, as it’s application isn’t
> saturated.
>
> {-# LANGUAGE TypeOperators #-}
> type (:.:) f g x = f (g x)
> infixr 9 :.:
>
> type App = Maybe :.: []
>
> fails to compile with following errors (for a reason):
>
>     • The type synonym ‘:.:’ should have 3 arguments, but has been given 2
>     • In the type synonym declaration for ‘App’
>
> > On 02 Nov 2016, at 16:24, Edward Kmett <ekmett at gmail.com> wrote:
> >
> > +1, but the operator you're looking for in App there would actually be a
> type level version of (.).
> >
> > type App a = ExceptT Err $ ReaderT Config $ LogT Text $ IO a
> >
> > type App = ExceptT Err . ReaderT Config . LogT Text . IO
> >
> > which would need
> >
> > type (.) f g x = f (g x)
> > infixr 9 .
> >
> > to parse
> >
> > -Edward
> >
> > On Tue, Nov 1, 2016 at 7:13 PM, Elliot Cameron <eacameron at gmail.com>
> wrote:
> > Folks,
> >
> > Has there been a discussion about adding a type-level operator "$" that
> just mimics "$" at the value level?
> >
> > type f $ x = f x
> > infixr 0 $
> >
> > Things like monad transformer stacks would look more "stack-like" with
> this:
> >
> > type App = ExceptT Err $ ReaderT Config $ LogT Text IO
> >
> > Elliot Cameron
> >
> > _______________________________________________
> > Libraries mailing list
> > Libraries at haskell.org
> > http://mail.haskell.org/cgi-bin/mailman/listinfo/libraries
> >
> >
> > _______________________________________________
> > Libraries mailing list
> > Libraries at haskell.org
> > http://mail.haskell.org/cgi-bin/mailman/listinfo/libraries
>
>
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/libraries/attachments/20161102/6cc14872/attachment.html>


More information about the Libraries mailing list