Making (a, a) a Functor - haskell

How can I make (a, a) a Functor without resorting to a newtype?
Basically I want it to work like this:
instance Functor (a, a) where
fmap f (x, y) = (f x, f y)
But of course that's not a legal way to express it:
Kind mis-match
The first argument of `Functor' should have kind `* -> *',
but `(a, a)' has kind `*'
In the instance declaration for `Functor (a, a)'
What I really want is a type-level function like this: \a -> (a, a) (invalid syntax). So a type alias, perhaps?
type V2 a = (a, a)
instance Functor V2 where
fmap f (x, y) = (f x, f y)
I would think this would work, but it doesn't. First I get this complaint:
Illegal instance declaration for `Functor V2'
(All instance types must be of the form (T t1 ... tn)
where T is not a synonym.
Use -XTypeSynonymInstances if you want to disable this.)
In the instance declaration for `Functor V2'
If I follow the advice and add the TypeSynonymInstances extension, I get a new error:
Type synonym `V2' should have 1 argument, but has been given 0
In the instance declaration for `Functor V2'
Well, duh, that's the point! V2 has kind * -> * which is what is required of a Functor instance. Well, ok, I can use a newtype like this:
newtype V2 a = V2 (a, a)
instance Functor V2 where
fmap f (V2 (x, y)) = V2 (f x, f y)
But now I've got to sprinkle V2s liberally throughout my code instead of just being able to deal with simple tuples, which kind of defeats the point of making it a Functor; at that point I might as well make my own function vmap :: (a -> b) -> (a, a) -> (b, b).
So is there any way to do this nicely, i.e. without a newtype?

As others have stated, there's no way to do this without resorting to newtypes or data declarations. However, have you looked at Control.Arrow? Many of those functions are very useful with tuples, for example:
vmap :: (a -> b) -> (a,a) -> (b,b)
vmap f = f *** f

You can declare
instance Functor ((,) a) where
...
However that doesn't constrain the first element of your pair, and fmap would only act on the second element.
The issue is that a tuple doesn't enforce a relationship between the types of the two elements.
If you don't want a newtype decorator you can make your own fresh type:
data Pair a = P a a
instance Functor Pair where
...
which will be easier to work with than a newtype around a tuple.

With singletons you can define a Functor type class for defunctionalized symbols (Type ~> Type instead of Type -> Type)
{-# Language ExplicitNamespaces, TypeApplications, TypeOperators, KindSignatures, ScopedTypeVariables, DataKinds, TypeInType, TypeFamilies, AllowAmbiguousTypes, InstanceSigs #-}
import Data.Kind (Type)
import Data.Singletons (type (~>), Apply)
class Functor' (f :: Type ~> Type) where
fmap' :: (a -> a') -> (Apply f a -> Apply f a')
data Dup :: Type ~> Type
type instance Dup `Apply` a = (a, a)
instance Functor' Dup where
fmap' :: (a -> a') -> ((a, a) -> (a', a'))
fmap' f (a1, a2) = (f a1, f a2)
This gives you a Prelude.Functor instance automatically
newtype f $ a = App (Apply f a)
instance Functor' f => Functor (($) f) where
fmap :: (a -> a') -> (f $ a -> f $ a')
fmap f (App fa) = App (fmap' #f f fa)

Related

Quantified type equality of associated type families

I have an associated type family Bar in a type class Foo. Foo' requires that Bar f ~ Bar (f a) for all a, but in another function test I get an error Couldn't match type 'Bar f' with 'Bar (f a)', even though it depends on Foo' f. The code:
{-# LANGUAGE TypeFamilies, PolyKinds, QuantifiedConstraints #-}
import Data.Proxy
class Foo f where
type Bar f
class (Foo f, forall a. Foo (f a), forall a. Bar f ~ Bar (f a)) => Foo' f where
test :: Foo' f => Proxy (f a) -> Bar (f a) -> Bar f
test _ = id
Why can't GHC figure out this type equality and is there a way to help the typechecker without asserting the concrete equality in test?
Type families and quantified constraints don't mix. Much even less with type equalities. But there is a way to keep them separate to achieve more or less the same result.
A quantified constraint is actually restricted in the ways it can be used. It's not sufficient to know that a constraint holds for all types, you also need a way to know which types you need to specialize it to. GHC achieves this by representing quantified constraints as a sort of "local instance" subject to the common rules of instance resolution. I'm not sure quantified type equalities even mean anything. In summary, it's not enough that a quantified constraint can be instantiated to do what we want; that instantiation must happen in the regular course of instance resolution, and that puts restrictions on the allowed forms of quantified constraints.
The trick is to define a class synonym for the body of the quantified constraint:
class (Bar f ~ Bar (f a)) => EBar f a
instance (Bar f ~ Bar (f a)) => EBar f a
That way we can rewrite the quantified constraint as forall x. EBar f x, no type families in sight:
class (Foo f, forall a. Foo (f a), forall x. EBar f x) => Foo' f where
To use this class, we need an explicit function to specialize the quantified constraint (the problem is that if we use an equality Bar f ~ Bar (f a) directly, the type checker can't relate that to the quantified constraint forall x. EBar f x, which looks nothing like it):
-- Morally a function on constraints `(forall x. EBar f x) => EBar f a`
-- in continuation-passing style: (x => y) is isomorphic to forall r. (y => r) -> (x => r)
ebar :: forall f a r. (EBar f a => Proxy (f a) -> r) -> (forall x. EBar f x) => Proxy (f a) -> r
ebar f = f
test :: Foo' f => Proxy (f a) -> Bar (f a) -> Bar f
test = ebar (\_ -> id)
{-# LANGUAGE RankNTypes, MultiParamTypeClasses, FlexibleInstances, TypeFamilies, PolyKinds, QuantifiedConstraints #-}
import Data.Proxy
class Foo f where
type Bar f
class (Foo f, forall a. Foo (f a), forall a. EBar f a) => Foo' f where
class (Bar f ~ Bar (f a)) => EBar f a
instance (Bar f ~ Bar (f a)) => EBar f a
ebar :: forall f a r. (EBar f a => Proxy (f a) -> r) -> (forall x. EBar f x) => Proxy (f a) -> r
ebar f = f
test :: Foo' f => Proxy (f a) -> Bar (f a) -> Bar f
test = ebar (\_ -> id)

Writing a generic functor instance across type constructors?

I'm learning basic type classes and have written my own implementation of functor for my type Test a (behaves just like Maybe):
data Test a = Test a | Emp
class FC c a where
t :: (a -> b) -> c a -> c b
instance FC Test a where
t f (Test a) = Test (f a)
t f (Emp) = Emp
instance FC Maybe a where
t f (Just a) = Just (f a)
t f (Nothing) = Nothing
Is it possible to implement something like:
instance FC c where
t f (c v) = c (f v)
Error:
Parse error in pattern: c
In other words, abstract away the type constructor, replace with c and v, therefore creating a general instance that can be applied to any value with a context?
As you've learned, c a is not a syntactically valid pattern. But reading your question instead as a feature proposal: How would that work? Not every Functor has a single-element constructor which can be mapped over according to your pattern. Some examples:
data Pair a = Pair a a -- more than one element
instance Functor Pair where
fmap f (Pair x y) = Pair (f x) (f y)
data Proxy a = Proxy -- no elements
instance Functor Proxy where
fmap f Proxy = Proxy
newtype Cont r a = Cont { runCont :: (a -> r) -> r } -- element appears in a double-negative position
instance Functor (Cont r) where
fmap f (Cont g) = Cont (g . (. f))
In any case, I don't think the idea of a "generic instance" really makes sense. The instance is where you put your type-specific code. (It has to go somewhere!)
If you want to exert less effort in writing Functor instances you can use GHC's DeriveFunctor extension.
{-# LANGUAGE DeriveFunctor #-}
data Pair a = Pair a a deriving Functor
data Proxy a = Proxy deriving Functor
newtype Cont r a = Cont { runCont :: (a -> r) -> r } deriving Functor
You can do something very generic using GHC.Generic. Here is an incomplete example for a generic FC class definition (this is exactly what the generic-deriving package does):
First some extensions and importing the generics machinery
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TypeOperators #-}
import GHC.Generics
Then we define a class which mirrors your FC but we only have instances for the generic types
class GFC c where
gt :: (a -> b) -> c a -> c b
-- Constructors without arguments (Empty)
instance GFC U1 where
gt _ U1 = U1
-- Constructors where the parameter appears (Test a)
instance GFC Par1 where
gt f (Par1 a) = Par1 (f a)
-- Sums (| in datatype definitions)
instance (GFC f, GFC g) => GFC (f :+: g) where
gt f (L1 a) = L1 (gt f a)
gt f (R1 a) = R1 (gt f a)
-- Meta information wrapper
instance GFC f => GFC (M1 i c f) where
gt f (M1 a) = M1 (gt f a)
-- ... the rest of the instances for the generic types here.
-- But these 4 instances are all that is needed for your `Test` type.
Then you can have a default implementation for FC based on the above "generic" FC:
class FC c where
t :: (a -> b) -> c a -> c b
default -- DefaultSignatures allows us to do this
t :: (Generic1 c, GFC (Rep1 c)) => (a -> b) -> c a -> c b
t f = to1 . gt f . from1
-- turn something with Generic1 into its generic representation,
-- use the generic `gt` and then turn it back into its actual
-- representation
data Test a = Test a | Empty
deriving (Generic1, Show)
instance FC Test
And it works:
GHCI> t (==0) (Test (1 :: Int))
Test False
As far as I know this is not possible, simply because there can be multiple constructors and it is unknown whether a generic constructor Foo can take any attribute as type.
Say for instance you have a type called:
data Foo a = Bar Int | Qux a
Now it means you cannot abstract away the constructor. As long as it is Qux, there is no problem, but Bar always expects an Int and thus will error. Since you here define an instance over any kind of c, there will be cases where this does not work. Note furthermore that the c in your instance declaration has nothing to do with the c in your definition of t. In other words: constructors can imply type constraints so you cannot simply factor them out.
A remark on your question is that you can generalize both you class defintion and instance:
class FC c where
t :: (a -> b) -> c a -> c b
instance FC Test where
t f (Test a) = Test (f a)
t f Emp = Emp
So you can remove the a in the class definition. This is not equivalent with your questions since here you say that it can work for any a. Whereas when you define a class FC c a you can decide for which as you want implement an instance.

Is it possible to encode a generic "lift" function in Haskell?

I'm not the biggest fan of varargs, but I always thought both the applicative (f <$> x <*> y) and idiom ([i| f x y |]) styles have too many symbols. I usually prefer going the liftA2 f x y way, but I, too, think that A2 is a little ugly. From this question, I've learned it is possible to implement vararg functions in Haskell. This way, is it possible to use the same principle in order implement a lift function, such that:
lift f a b == pure f <*> a <*> b
I've tried replacing the + by <*> on the quoted code:
class Lift r where
lift :: a -> r
instance Lift a where
lift = id
instance (Lift r) => Lift (a -> r) where
lift x y = lift (x <*> y)
But I couldn't manage to get the types right...
Notice that you can chain any number of <*>, to get a function of the form
f (a0 -> .. -> an) -> (f a0 -> .. -> f an)
If we have the type a0 -> .. -> an and f a0 -> .. -> f an, we can compute f from this. We can encode this relation, and the most general type, as follows
class Lift a f b | a b -> f where
lift' :: f a -> b
As you may expect, the "recursive case" instance will simply apply <*> once, then recurse:
instance (a ~ a', f' ~ f, Lift as f rs, Applicative f)
=> Lift (a -> as) f (f' a' -> rs) where
lift' f a = lift' $ f <*> a
The base case is when there is no more function. Since you can't actually assert "a is not a function type", this relies on overlapping instances:
instance (f a ~ b) => Lift a f b where
lift' = id
Because of GHCs instance selection rules, the recursive case will always be selected, if possible.
Then the function you want is lift' . pure :
lift :: (Lift a f b, Applicative f) => a -> b
lift x = lift' (pure x)
This is where the functional dependency on Lift becomes very important. Since f is mentioned only in the context, this function would be ill-typed unless we can determine what f is knowing only a and b (which do appear in the right hand side of =>).
This requires several extensions:
{-# LANGUAGE
OverlappingInstances
, MultiParamTypeClasses
, UndecidableInstances
, FunctionalDependencies
, ScopedTypeVariables
, TypeFamilies
, FlexibleInstances
#-}
and, as usual with variadic functions in Haskell, normally the only way to select an instance is to give an explicit type signature.
lift (\x y z -> x * y + z) readLn readLn readLn :: IO Int
The way I have written it, GHC will happily accept lift which is polymorphic in the arguments to f (but not f itself).
lift (+) [1..5] [3..5] :: (Enum a, Num a) => [a]
Sometimes the context is sufficient to infer the correct type. Note that the argument type is again polymorphic.
main = lift (\x y z -> x * y + z) readLn readLn readLn >>= print
As of GHC >= 7.10, OverlappingInstances has been deprecated and the compiler will issue a warning. It will likely be removed in some later version. This can be fixed by removing OverlappingInstances from the {-# LANGUAGE .. #-} pragma and changing the 2nd instance to
instance {-# OVERLAPS #-} (f a ~ b) => Lift a f b where
I assume you would prefer to use lift without type annotations. In this case there are basically two options:
First, if we use OverlappingInstances, polymorphic functions need annotations:
{-# LANGUAGE
OverlappingInstances,
MultiParamTypeClasses,
UndecidableInstances,
FunctionalDependencies,
FlexibleInstances,
TypeFamilies
#-}
import Control.Applicative
class Applicative f => ApN f a b | a b -> f where
apN :: f a -> b
instance (Applicative f, b ~ f a) => ApN f a b where
apN = id
instance (Applicative f, ApN f a' b', b ~ (f a -> b')) => ApN f (a -> a') b where
apN f fa = apN (f <*> fa)
lift :: ApN f a b => a -> b
lift a = apN (pure a)
-- Now we can't write "lift (+) (Just 0) Nothing"
-- We must annotate as follows:
-- lift ((+) :: Int -> Int -> Int) (Just 0) Nothing
-- Monomorphic functions work fine though:
-- lift (||) (Just True) (Just True) --> results in "Just True"
Second, if we instead use IncoherentInstances, lift will work without annotations even on polymorphic functions. However, some complicated stuff still won't check out, for example (lift . lift) (+) (Just (Just 0)) Nothing.
{-# LANGUAGE
IncoherentInstances, MultiParamTypeClasses,
UndecidableInstances,ScopedTypeVariables,
AllowAmbiguousTypes, FlexibleInstances, TypeFamilies
#-}
import Control.Applicative
class Applicative f => ApN f a b where
apN :: f a -> b
instance (Applicative f, b ~ f a) => ApN f a b where
apN = id
instance (Applicative f, ApN f a' b', b ~ (f a -> b')) => ApN f (a -> a') b where
apN f fa = apN (f <*> fa)
lift :: forall f a b. ApN f a b => a -> b
lift a = (apN :: f a -> b) (pure a)
-- now "lift (+) (Just 0) (Just 10)" works out of the box
I presented two solutions instead of just the one with IncoherentInstances because IncoherentInstances is a rather crude extension that should be avoided if possible. It's probably fine here, but I thought it worthwhile to provide an alternative solution, anyway.
In both cases I use the same trick to help inference and reduce annotations: I try to move information from the instance heads to the instance constraints. So instead of
instance (Applicative f) => ApN f a (f a) where
apN = id
I write
instance (Applicative f, b ~ f a) => ApN f a b where
apN = id
Also, in the other instance I use a plain b parameter in the instance head and add b ~ (f a ~ b') to the constraints.
The reason for doing this is that GHC first checks if there is a matching instance head, and it tries to resolve the constraints only after there is a successful match. We want to place the least amount of burden on the instance head, and let the constraint solver sort things out (because it's more flexible, can delay making judgements and can use constraints from other parts of the program).

Why does Functor not expose a default implementation of fmap?

In the Functor class type definition:
class Functor f where
fmap :: (a -> b) -> f a -> f b
Why does fmap not have a default implementation? Something like that:
class Functor f where
fmap :: (a -> b) -> f a -> f b
fmap fn (f a) = (f $ (fn) a)
When I write instances of Functor, I write the same code for each instance manually. Is there a way for me to specify a default implementation?
You probably want this:
{-# LANGUAGE DeriveFunctor #-}
data T1 a = T1 a
deriving Functor
data T2 a = T2 a
deriving Functor
As to why there's no default implementation for functor: your proposal only works if f is the identity functor (up to isomorphism). That is, it works on
data F a = F a
but it is not going to work on
data F a = F a a
or
data F a = F (Int -> a) [a] (Maybe a)
which require more complex fmaps.
While one can not write a default fmap which works in every case, in many simple cases such as the above ones it seems trivial to spot what fmap should be.
Fortunately, we now have derive Functor which covers these simple cases.

Typed expression parser

I'm trying to create a typed expression parser in Haskell, which works great so far, but I'm currently struggling to implement higher order functions. I've boiled the problem down to a simple example:
{-# LANGUAGE TypeFamilies,GADTs,FlexibleContexts,RankNTypes #-}
-- A function has an argument type and a result type
class Fun f where
type FunArg f
type FunRes f
-- Expressions are either constants of function applications
data Expr a where
Const :: a -> Expr a
App :: Fun f => f -> FunArg f -> Expr (FunRes f)
-- A very simple function
data Plus = Plus
-- Which takes two integer expressions and returns an integer expression
instance Fun Plus where
type FunArg Plus = (Expr Int,Expr Int)
type FunRes Plus = Int
-- A more complicated function which lifts a function to lists (like in haskell)
data Map f r = Map f
-- For this we need the concept of lifting function arguments:
class Liftable a where
type LiftRes a
-- A singleton argument is lifted by changing the expression type from a to [a]
instance Liftable (Expr a) where
type LiftRes (Expr a) = Expr [a]
-- Two function arguments are lifted by lifting each argument
instance (Liftable a,Liftable b) => Liftable (a,b) where
type LiftRes (a,b) = (LiftRes a,LiftRes b)
-- Now we can declare a function instance for Map
instance (Fun f,Liftable (FunArg f),r ~ LiftRes (FunArg f)) => Fun (Map f r) where
type FunArg (Map f r) = r
type FunRes (Map f r) = [FunRes f]
-- Now a parser for functions:
parseFun :: [String] -> (forall f. Fun f => f -> a) -> a
-- The parser for the plus function is easy:
parseFun ["plus"] f = f Plus
-- But the parser for map is not possible:
parseFun ("map":sym) f
= parseFun sym (\fun -> f (Map fun))
The problem seems to be that there is no way to convince the type checker that every LiftRes is itself Liftable, because recursive class declarations are forbidden.
My question is: How do I make this work? Are there other examples of typed expression parsers from which I could take hints?
EDIT: It seems that this discussion about type family constraints seems to be very related. However, I fail to make their solution work in my case, maybe someone can help with that?
The easiest way to make your example work is to remove the Liftable (FunArg f) constraint from the instance declaration. But I think your example is just so condensed that it doesn't show why you actually need it.
So the next best thing is to add a Liftable (FunArg f) superclass constraint to the Fun class:
class Liftable (FunArg f) => Fun f where
...
If this is not feasible (i.e., if not all your functions have liftable argument types), then you cannot expect to write a parseFun of the given type.
A more general remark: I think what you're trying to do here is very strange, and perhaps too much at once. Parsing from unstructured strings into a context-free datatype is already difficult enough. Why not do that first, and write a separate function that transforms the "untyped", but structured representation of your language into a typed one.
EDIT (as a reaction to the comments, revised): As pointed out in the discussion on type family constraints that you also linked in your question, you can bypass the superclass cycle restriction by using ConstraintKinds. Here is a way to make your reduced example work. Perhaps this will scale to the full solution?
{-# LANGUAGE RankNTypes, ScopedTypeVariables, TypeFamilies, FlexibleContexts, GADTs #-}
import Data.Constraint -- from the constraints package
import Data.Proxy -- from the tagged package
-- A function has an argument type and a result type
class Liftable (FunArg f) => Fun f where
type FunArg f
type FunRes f
-- Expr, Plus, and instance Fun Plus as before
class Liftable a where
type LiftRes a
get :: p a -> Dict (Liftable (LiftRes a))
-- acquire "superclass" dictionary by calling this method and
-- then pattern matching on the result
instance Liftable (Expr a) where
type LiftRes (Expr a) = Expr [a]
get _ = Dict
instance (Liftable a, Liftable b) => Liftable (a, b) where
type LiftRes (a, b) = (LiftRes a, LiftRes b)
get (_ :: p (a, b)) =
case get (Proxy :: Proxy a) of -- extra code required
Dict -> case get (Proxy :: Proxy b) of -- extra code required
Dict -> Dict
data Map f r = Map f
instance (Fun f, Liftable r, r ~ LiftRes (FunArg f)) => Fun (Map f r) where
type FunArg (Map f r) = r
type FunRes (Map f r) = [FunRes f]
parseFun :: forall a. [String] -> (forall f. Fun f => f -> a) -> a
parseFun ["plus"] f = f Plus
parseFun ("map" : sym) f = parseFun sym
(\ (fun :: g) -> case get (Proxy :: Proxy (FunArg g)) of -- extra code required
Dict -> f (Map fun))

Resources