[Haskell-cafe] Is 'flip' really necessary?

Nils Schweinsberg ml at n-sch.de
Mon Jul 26 19:09:45 EDT 2010


On 26.07.2010 23:55, Ozgur Akgun wrote:
> I think it is pretty cool as well. But I think there is a problem with
> viewing it as a wildcard.
>
> let's say we define the following:
>
> (??) = flip
>
> foo :: a -> b -> c
> foo ?? x :: a -> c
>
> Perfect!
>
> But saying ?? can be used as a wildcard might in the following wrong
> perception:
>
> foo x ?? :: b -> c -- WRONG

This looks interesting. I played around with this for a bit:


{-# LANGUAGE MultiParamTypeClasses
            , FunctionalDependencies
            , FlexibleInstances
            #-}

class Wildcard f v r | f -> v r where
     (??) :: f -> v -> r

instance Wildcard (a -> b -> c) b (a -> c) where
     (??) = flip

instance Wildcard (b -> c) b c where
     (??) = id

f :: String -> Int -> String
f s i = s ++ show i

a :: String -> String
a = (f ?? 5)

b :: Int -> String
b = (f "Int: " ??)



Sadly, this won't typecheck:


pattern.hs:19:0:
     Couldn't match expected type `Int' against inferred type `[Char]'
       Expected type: Int
       Inferred type: String
     When using functional dependencies to combine
       Wildcard (b -> c) b c,
         arising from the dependency `f -> a r'
         in the instance declaration at pattern.hs:12:9
       Wildcard (String -> Int -> String) Int (String -> String),
         arising from a use of `??' at pattern.hs:19:5-10
     When generalising the type(s) for `a'


Ideas anyone? :)


More information about the Haskell-Cafe mailing list