{-# LANGUAGE TypeFamilies #-}
import GHC.Prim
import qualified Data.Set as Set
class Functor' f where
type FConstraint f :: * -> Constraint
fmap' :: (FConstraint f a, FConstraint f b) => (a -> b) -> f a -> f b
instance Functor' Set.Set where
type FConstraint Set.Set = Ord Num --error here, won't let me put Num
fmap' = Set.map
I was wondering how I could make the above work. Now I know I could manually require two typeclasses, but I was hoping to be able to combine any arbitrary amount of them.
Now I know requiring Num does not make sense in this case, but this is purely an example.
You will need to define a typeclass (since typeclasses can be partially applied ) which reduces to the constraint you want through a superclass:
{-# LANGUAGE
PolyKinds, UndecidableInstances, TypeOperators
, MultiParamTypeClasses, ConstraintKinds, TypeFamilies
, FlexibleContexts, FlexibleInstances
#-}
class (f x, g x) => (&) f g (x :: k)
instance (f x, g x) => (&) f g x
Clearly (f & g) x holds iff f x and g x hold. The definition of FConstraint' should be obvious now:
class Functor' ...
instance Functor' Set.Set where
type FConstraint Set.Set = Ord & Num
fmap' f = Set.map ( (+1) . f ) -- (+1) to actually use the Num constraint
Looks like the only change I needed to make was not partially apply FConstraint:
{-# LANGUAGE TypeFamilies #-}
import GHC.Prim
import qualified Data.Set as Set
class Functor' f where
type FConstraint f a :: Constraint
fmap' :: (FConstraint f a, FConstraint f b) => (a -> b) -> f a -> f b
instance Functor' Set.Set where
type FConstraint Set.Set a = (Ord a, Num a)
fmap' f = Set.map ((+ 1) . f)
foo = fmap (+ 1) $ Set.fromList [1, 2, 3]
Unfortunately this does not allow me to use a concrete type as far as I can tell, but I suppose that wouldn't even match with Functor on a kind level anyway (Functor has kind * -> * but a list of concrete values such as String has kind *).
Related
Consider the data type
data Foo f = Foo {fooInt :: f Int, fooBool :: f Bool}
I would like a function mapFoo :: (forall a. f a -> g a) -> Foo f -> Foo g. My options:
I could write it manually. This is mildly annoying, but the killer objection is that I expect Foo to gain fields over time and I want that to be as frictionless as possible, so having to add a case to this function is annoying.
I could write Template Haskell. I'm pretty sure this isn't too hard, but I tend to view TH as a last resort, so I'm hoping for something better.
Could I use generics? I derived Generic, but when I tried to implement the K1 case (specifically to handle Rec0) I couldn't figure out how to do it; I needed it to change the type.
Is there a fourth option that I just missed?
If there is a generic way to write mapFoo without reaching for Template Haskell, I'd love to know about it! Thanks.
The rank2classes package can derive this for you.
{-# LANGUAGE TemplateHaskell #-}
import Rank2.TH (deriveFunctor)
data Foo f = Foo {fooInt :: f Int, fooBool :: f Bool}
$(deriveFunctor ''Foo)
Now you can write mapFoo = Rank2.(<$>).
EDIT: Oh, I should be explicit that this is a manual method - it's a pointer to a package that has lots of useful functions and type classes but afaik no TH to generate what you want. Pull requests welcome, I'm sure.
The parameterized-utils package provides a rich set of higher rank classes. For your needs there's FunctorF:
-- | A parameterized type that is a function on all instances.
class FunctorF m where
fmapF :: (forall x . f x -> g x) -> m f -> m g
And the instances are what you probably expect:
{-# LANGUAGE RankNTypes #-}
import Data.Parameterized.TraversableF
data Foo f = Foo {fooInt :: f Int, fooBool :: f Bool}
instance FunctorF Foo where
fmapF op (Foo a b) = Foo (op a) (op b)
Here is GHC.Generics-based implementation if you still prefer not to use TemplateHaskell:
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
import GHC.Generics
data Foo f = Foo {
fooInt :: f Int,
fooBool :: f Bool,
fooString :: f String
} deriving (Generic)
class Functor2 p q f where
fmap2 :: (forall a. p a -> q a) -> f p -> f q
instance (Generic (f p), Generic (f q), GFunctor2 p q (Rep (f p)) (Rep (f q))) => Functor2 p q f where
fmap2 f = to . (gfmap2 f) . from
class GFunctor2 p q f g where
gfmap2 :: (forall a. p a -> q a) -> f x -> g x
instance (GFunctor2 p q a b) => GFunctor2 p q (D1 m1 (C1 m2 a)) (D1 m1 (C1 m2 b)) where
gfmap2 f (M1 (M1 a)) = M1 (M1 (gfmap2 f a))
instance (GFunctor2 p q a c, GFunctor2 p q b d) => GFunctor2 p q (a :*: b) (c :*: d) where
gfmap2 f (a :*: b) = gfmap2 f a :*: gfmap2 f b
instance GFunctor2 p q (S1 m1 (Rec0 (p a))) (S1 m1 (Rec0 (q a))) where
gfmap2 f (M1 (K1 g)) = M1 (K1 (f g))
-- Tests
foo = Foo (Just 1) (Just True) (Just "foo")
test1 = fmap2 (\(Just a) -> [a]) foo
test2 = fmap2 (\[a] -> Left "Oops") test1
I'm not sure though if it is possible to avoid MultiParamTypeClasses to make class Functor2 identical to the one defined rank2classes.
Is there a way to define "pairmap" like the following:
pairmap f (x,y) = (f x, f y)
So that the following works:
pairmap (+2) (1::Int, 2::Float)
pairmap succ (1::Int, 'a')
pairmap Just ('a', True)
etc.
Naturally, in the first case, both the elements must be of class Num, and in the second case, both of class Enum. In the third case however, there's no restriction required.
Answer (but could be improved)
The following code (ideone) solves the problem, but note that my functions have to be wrapped in a datatype that encapsulates both the relation between the input and output types and also any constraints on the input type. This works but there's a bit of boilerplate. It would be nice if I could use a bit less boilerplate to achieve this, so any answer would be appreciated (although this solution is reasonably fine for my purposes).
{-# LANGUAGE GADTs #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE RankNTypes #-}
import GHC.Exts (Constraint)
class Function f where
type Constraints f a :: Constraint
type instance Constraints f a = ()
type Result f a
type instance Result f a = a
applyFunc :: (Constraints f a) => f -> a -> Result f a
pairmap ::
(Function f, Constraints f a, Constraints f b) =>
f -> (a, b) -> (Result f a, Result f b)
pairmap f (x,y) = (applyFunc f x, applyFunc f y)
data NumFunc where
NumFunc :: (forall a. Num a => a -> a) -> NumFunc
instance Function NumFunc where
type Constraints NumFunc a = (Num a)
applyFunc (NumFunc f) = f
data EnumFunc where
EnumFunc :: (forall a. Enum a => a -> a) -> EnumFunc
instance Function EnumFunc where
type Constraints EnumFunc a = (Enum a)
applyFunc (EnumFunc f) = f
data MaybeFunc where
MaybeFunc :: (forall a. a -> Maybe a) -> MaybeFunc
instance Function MaybeFunc where
type Result MaybeFunc a = Maybe a
applyFunc (MaybeFunc f) = f
y1 = pairmap (NumFunc (+2)) (1::Int, 2::Float)
y2 = pairmap (EnumFunc succ) (1::Int, 'a')
y3 = pairmap (MaybeFunc Just) ('a', True)
main = do
print y1
print y2
print y3
Answer 2
I think this is better and more flexible (ideone), but again, any improvements to reduce the boilerplate welcome:
{-# LANGUAGE GADTs #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE UndecidableSuperClasses #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TypeApplications #-}
import GHC.Exts (Constraint)
data Func (c :: (* -> * -> Constraint)) where
Func :: (forall a b. c a b => a -> b) -> Func c
class (c a, a ~ b) => BasicConstraint c a b
instance (c a, a ~ b) => BasicConstraint c a b
numFunc = Func #(BasicConstraint Num)
enumFunc = Func #(BasicConstraint Enum)
class (c a, t a ~ b) => NewtypeConstraint c t a b
instance (c a, t a ~ b) => NewtypeConstraint c t a b
class EmptyConstraint a
instance EmptyConstraint a
maybeFunc = Func #(NewtypeConstraint EmptyConstraint Maybe)
applyFunc :: Func c -> (forall a b. c a b => a -> b)
applyFunc (Func f) = f
pairmap :: (c a a', c b b') => Func c -> (a, b) -> (a', b')
pairmap f (x,y) = (applyFunc f x, applyFunc f y)
main = do
print $ pairmap (numFunc (+2)) (1::Int, 2::Float)
print $ pairmap (enumFunc succ) (1::Int, 'a')
print $ pairmap (maybeFunc Just) ('a', True)
The first two of your examples are somewhat simpler to generalize than the third.
{-# LANGUAGE RankNTypes, ConstraintKinds, KindSignatures, AllowAmbiguousTypes, TypeApplications #-}
import GHC.Exts (Constraint)
pairmap :: forall (c :: * -> Constraint) d e. (c d, c e) =>
(forall a. (c a) => a -> a) -> (d,e) -> (d,e)
pairmap f (x,y) = (f x, f y)
The caveat with this solution is that you need to explicitly instantiate the constraint you are using:
ghci> pairmap #Num (+1) (1 :: Int, 1.0 :: Float)
(2,2.0)
As for the third, here is a half solutions. If the second type is always a type parametrized over the first (like f a), then you can do the same thing as above (albeit your first examples cease to work - you could make them work by wrapping them in Identity).
pairmap' :: forall (c :: * -> Constraint) f d e. (c d, c e) =>
(forall a. (c a) => a -> f a) -> (d,e) -> (f d,f e)
pairmap' f (x,y) = (f x, f y)
And again, at GHCi
ghci> pairmap' #Num (Just . (+1)) (1 :: Int , 1.0 :: Float)
(Just 2,Just 2.0)
I'm trying this (for learning purposes):
{-# LANGUAGE FlexibleInstances #-}
instance Monoid (a -> a) where
mempty = id
mappend f g = f . g
expecting id <> id to be equal to id . id
However, with (id <> id) 1 I receive this error:
Non type-variable argument in the constraint: Monoid (a -> a)
What should I change to run it?
It's just to understand monoids and Haskell typeclasses better, not for any practical usage.
This will need {-# OVERLAPPING #-} pragma since GHC.Base has an instance for Monoid (a -> b) when b is a Monoid:
{-# LANGUAGE FlexibleInstances #-}
import Data.Monoid (Monoid, mempty, mappend, (<>))
instance {-# OVERLAPPING #-} Monoid (a -> a) where
mempty = id
mappend f g = f . g
then, above instance will be invoked for a -> a, even if a is a Monoid:
\> (id <> id) 1
1
\> (id <> id) [1]
[1]
whereas with Monoid b => a -> b the instance from GHC.Base will be invoked:
\> ((:[]) <> (:[])) 1
[1,1]
Note that Data.Monoid provides an exact same instance as yours for a -> a but there the overlap is bypassed using newtype Endo a.
The Haskell Category class offers methods to work with categories whose objects are precisely the Haskell types of some kind. Specifically,
class Category c where
id :: c x x
(.) :: c y z -> c x y -> c x z
The names of the methods should look very familiar. Notably,
instance Category (->) where
id x = x
f . g = \x -> f (g x)
You probably know that monoids are semigroups with identities, expressed in Haskell using
class Monoid a where
mappend :: a -> a -> a
mempty :: a
But another mathematical perspective is that they're categories with exactly one object. If we have a monoid, we can easily turn it into a category:
-- We don't really need this extension, but
-- invoking it will make the code below more useful.
{-# LANGUAGE PolyKinds #-}
import Control.Category
import Data.Monoid
import Prelude hiding ((.), id)
newtype Mon m a b = Mon m
instance Monoid m => Category (Mon m) where
id = Mon mempty
Mon x . Mon y = Mon (x `mappend` y)
Going the other way is a little bit trickier. One way to do it is to choose a kind with exactly one type, and look at categories whose sole object is that type (prepare for yucky code, which you can skip if you like; the bit below is less scary). This shows that we can freely convert between a Category whose object is the type '() in the () kind and a Monoid. The arrows of the category become the elements of the monoid.
{-# LANGUAGE DataKinds, GADTs, PolyKinds #-}
data Cat (c :: () -> () -> *) where
Cat :: c '() '() -> Cat c
instance Category c => Monoid (Cat c) where
mempty = Cat id
Cat f `mappend` Cat g = Cat (f . g)
But this is yucky! Ew! And pinning things down so tightly doesn't usually accomplish anything from a practical perspective. But we can get the functionality without so much mess, by playing a little trick!
{-# LANGUAGE GADTs, PolyKinds #-}
import Control.Category
import Data.Monoid
import Prelude hiding ((.), id)
newtype Cat' (c :: k -> k -> *) (a :: k) (b :: k) = Cat' (c a b)
instance (a ~ b, Category c) => Monoid (Cat' c a b) where
mempty = Cat' id
Cat' f `mappend` Cat' g = Cat' (f . g)
Instead of confining ourselves to a Category that really only has one object, we simply confine ourselves to looking at one object at a time.
The existing Monoid instance for functions makes me sad. I think it would be much more natural to use a Monoid instance for functions based on their Category instance, using the Cat' approach:
instance a ~ b => Monoid (a -> b) where
mempty = id
mappend = (.)
Since there's already a Monoid instance, and overlapping instances are evil, we have to make do with a newtype. We could just use
newtype Morph a b = Morph {appMorph :: a -> b}
and then write
instance a ~ b => Monoid (Morph a b) where
mempty = Morph id
Morph f `mappend` Morph g = Morph (f . g)
and for some purposes maybe this is the way to go, but since we're using a newtype already we usually might as well drop the non-standard equality context and use Data.Monoid.Endo, which builds that equality into the type:
newtype Endo a = Endo {appEndo :: a -> a}
instance Monoid (Endo a) where
mempty = Endo id
Endo f `mappend` Endo g = Endo (f . g)
It's possible to mix classes with lenses to simulate overloaded record fields, up to a point. See, for example, makeFields in Control.Lens.TH. I'm trying to figure out if there's a nice way to reuse the same name as a lens for some types and a traversal for others. Notably, given a sum of products, each product can have lenses, which will degrade to traversals of the sum. The simplest thing I could think of was this**:
First try
class Boo booey where
type Con booey :: (* -> *) -> Constraint
boo :: forall f . Con booey f => (Int -> f Int) -> booey -> f booey
This works fine for simple things, like
data Boop = Boop Int Char
instance Boo Boop where
type Con Boop = Functor
boo f (Boop i c) = (\i' -> Boop i' c) <$> f i
But it falls on its face as soon as you need anything more complicated, like
instance Boo boopy => Boo (Maybe boopy) where
which should be able to produce a Traversal regardless of the choice of underlying Boo.
Second try
The next thing I tried, which sort of works, is to constrain the Con family. This gets kind of gross. First, change the class:
class LTEApplicative c where
lteApplicative :: Applicative a :- c a
class LTEApplicative (Con booey) => Boo booey where
type Con booey :: (* -> *) -> Constraint
boo :: forall f . Con booey f => (Int -> f Int) -> booey -> f booey
This makes Boo instances carry around explicit evidence that their boo produces a Traversal' booey Int. Some more stuff:
instance LTEApplicative Applicative where
lteApplicative = Sub Dict
instance LTEApplicative Functor where
lteApplicative = Sub Dict
-- flub :: Boo booey => Traversal booey booey Int Int
flub :: forall booey f . (Boo booey, Applicative f) => (Int -> f Int) -> booey -> f booey
flub = case lteApplicative of
Sub (Dict :: Dict (Con booey f)) -> boo
instance Boo boopy => Boo (Maybe boopy) where
type Con (Maybe boopy) = Applicative
boo _ Nothing = pure Nothing
boo f (Just x) = Just <$> hum f x
where hum :: Traversal' boopy Int
hum = flub
And the base Boop example works unchanged.
Why this still sucks
We now have boo producing a Lens or Traversal under appropriate circumstances, and we can always use it as a Traversal, but every time we want to do so, we have to first drag in the evidence that it really is one. This is, of course, far too inconvenient for the purpose of implementing overloaded record fields! Is there any nicer way?
** This code compiles with the following (may not be minimal):
{-# LANGUAGE PolyKinds, TypeFamilies,
TypeOperators, FlexibleContexts,
ScopedTypeVariables, RankNTypes,
KindSignatures #-}
import Control.Lens
import Data.Constraint
The following has worked for me before:
{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}
import Control.Lens
data Boop = Boop Int Char deriving (Show)
class HasBoo f s where
boo :: LensLike' f s Int
instance Functor f => HasBoo f Boop where
boo f (Boop a b) = flip Boop b <$> f a
instance (Applicative f, HasBoo f s) => HasBoo f (Maybe s) where
boo = traverse . boo
It can be also scaled to polymorphic fields, if we make sure to enforce all the relevant functional dependencies (just like here). Leaving an overloaded field completely polymorphic is rarely useful or a good idea; I illustrate that case though because from there one can always monomorphize as necessary (or we can constrain polymorphic fields, for example a name field to IsString).
{-# LANGUAGE
UndecidableInstances, MultiParamTypeClasses,
FlexibleInstances, FunctionalDependencies, TemplateHaskell #-}
import Control.Lens
data Foo a b = Foo {_fooFieldA :: a, _fooFieldB :: b} deriving Show
makeLenses ''Foo
class HasFieldA f s t a b | s -> a, t -> b, s b -> t, t a -> s where
fieldA :: LensLike f s t a b
instance Functor f => HasFieldA f (Foo a b) (Foo a' b) a a' where
fieldA = fooFieldA
instance (Applicative f, HasFieldA f s t a b) => HasFieldA f (Maybe s) (Maybe t) a b where
fieldA = traverse . fieldA
One can also go a bit wild and use a single class for all "has" functionality:
{-# LANGUAGE
UndecidableInstances, MultiParamTypeClasses,
RankNTypes, TypeFamilies, DataKinds,
FlexibleInstances, FunctionalDependencies,
TemplateHaskell #-}
import Control.Lens hiding (has)
import GHC.TypeLits
import Data.Proxy
class Has (sym :: Symbol) f s t a b | s sym -> a, sym t -> b, s b -> t, t a -> s where
has' :: Proxy sym -> LensLike f s t a b
data Foo a = Foo {_fooFieldA :: a, _fooFieldB :: Int} deriving Show
makeLenses ''Foo
instance Functor f => Has "fieldA" f (Foo a) (Foo a') a a' where
has' _ = fooFieldA
With GHC 8, one can add
{-# LANGUAGE TypeApplications #-}
and avoid the proxies:
has :: forall (sym :: Symbol) f s t a b. Has sym f s t a b => LensLike f s t a b
has = has' (Proxy :: Proxy sym)
instance (Applicative f, Has "fieldA" f s t a b) => Has "fieldA" f (Maybe s) (Maybe t) a b where
has' _ = traverse . has #"fieldA"
Examples:
> Just (Foo 0 1) ^? has #"fieldA"
Just 0
> Foo 0 1 & has #"fieldA" +~ 10
Foo {_fooFieldA = 10, _fooFieldB = 1}
unsafeVacuous in Data.Void.Unsafe and .# and #. in Data.Profunctor.Unsafe both warn about the dangers of using those functions with functors/profunctors that are GADTs. Some dangerous examples are obvious:
data Foo a where
P :: a -> Foo a
Q :: Foo Void
instance Functor Foo where
fmap f (P x) = P (f x)
fmap f Q = P (f undefined)
Here, unsafeVacuous Q will produce a Q constructor with a bogus type.
This example isn't very troubling because it doesn't look even remotely like a sensible Functor instance. Are there examples that do? In particular, would it be possible to construct useful ones that obey the functor/profunctor laws when manipulated only using their public API, but break horribly in the face of these unsafe functions?
I don't believe there's any true functor where unsafeVacuous would cause a problem. But if you write a bad Functor you can make your own unsafeCoerce, which means it should to labeled with {-# LANGUAGE Unsafe #-}. There was an issue about it in void.
Here's an unsafeCoerce I came up with
{-# LANGUAGE GADTs #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
import Data.Void
import Data.Void.Unsafe
type family F a b where
F a Void = a
F a b = b
data Foo a b where
Foo :: F a b -> Foo a b
instance Functor (Foo a) where
fmap = undefined
unsafeCoerce :: forall a b. (F a b ~ b) => a -> b
unsafeCoerce a = (\(Foo b) -> b) $ (unsafeVacuous (Foo a :: Foo a Void) :: Foo a b)
main :: IO ()
main = print $ (unsafeCoerce 'a' :: Int)
which prints 97.