I have a type defined like this:
newtype PrimeSet a = P Integer
deriving Eq
I have also defined a function which converts a prime set to a list, given that its type parameter is an Integral.
toList :: Integral a => PrimeSet a -> [a]
I now what to give PrimeSet a Foldable instance, so this was my first attempt (after importing fold from Data.Foldable):
instance Foldable PrimeSet where
foldMap f = fold . map f . toList
This didn't work, however, and the compiler told me that it Could not deduce (Integral a) arising from a use of ‘toList’. My understanding of this message is that toList requires its argument to be an Integral a => PrimeSet a type, but this isn't necessarily the case in the Foldable instance.
The message also said that a possible fix would be to add Integral a to the context of the type signature for my foldMap implementation, but of course I was then told that I'm not allowed to provide my own type definitons for class methods unless I use InstanceSigs, so I tried that but that didn't seem to work either.
So my question is this: is it possible to add a type constraint to a class instance if the type parameter of the type I'm writing the class instance for is hidden - or, to reiterate, can I do something like this?
instance (Integral a) => Foldable (PrimeSet a) where
(This of course doesn't work because PrimeSet a has the kind * whereas Foldable requires * -> *)
No, this is not possible. The whole point of higher-kinded types is to work over any parameter type. Whereas PrimeSet isn't really parametric at all – basically, it's always PrimeSet Integer. Why do you have that a parameter at all?
There is however a different class for types that are “kinda containers”, but not for arbitrary types: MonoTraversable, or actually MonoFoldable in this case.
{-# LANGUAGE FlexibleInstances, TypeFamilies #-}
import Data.MonoTraversable
type instance Element (PrimeSet a) = a
-- or, if `PrimeSet` is not parameterised,
-- type instance Element PrimeSet = Integer
instance (Integral a) => MonoFoldable (PrimeSet a) where
otoList = YourImplementation.toList
An alternative would be that you do use parameterised types, functors in fact, but not in the normal Hask category of all Haskell types but only in the subcategory whose types areis Integer. I have such a class in my constrained-categories package. But, especially for this type you have, this really doesn't seem to make any sense.
You can use a GADT to constrain the parameter type:
{-# LANGUAGE GADTs #-}
data PrimeSet a where
PrimeSet :: Integral a => Integer -> PrimeSet a
instance Foldable PrimeSet where
foldr f b (PrimeSet x) = f (fromInteger x) b
You could generalise a little with ConstraintKinds (and the monofoldable class):
data Monomorphic f c a where
Monomorphic :: c a => f -> Monomorphic f c a
instance (item ~ Item f, MonoFoldable f) => Foldable (Monomorphic f ((~) item)) where
foldr f b (Monomorphic xs) = ofoldr f b xs
data PrimeSet = PrimeSet Integer
instance Foldable (Monomorphic PrimeSet Integral) where
foldr f b (Monomorphic (PrimeSet i)) = f (fromInteger i) b
I may be naive in my thinking here but I think if the right hand value of a Reader is an instance of Monoid then a Monoid could be defined for Reader... Here is my implementation:
instance Monoid a => Monoid (Reader r a) where
mempty = pure mempty
mappend ra rb = (<>) <$> ra <*> rb
This however results in the following error:
• Illegal instance declaration for ‘Monoid (Reader r a)’
(All instance types must be of the form (T t1 ... tn)
where T is not a synonym.
Use TypeSynonymInstances if you want to disable this.)
• In the instance declaration for ‘Monoid (Reader r a)’
|
413 | instance Monoid a => Monoid (Reader r a) where
| ^^^^^^^^^^^^^^^^^^^
I am unsure what this error actually means, and why I am unable to implement Monoid for Reader though I presume it is something to do with Reader being a higher kinded type?
There are two problems. The first is this:
type Reader r = ReaderT r Identity
For historical reasons, type synonyms are not allowed in instance declarations. This is the
where T is not a synonym.
part of the error. Luckily we can just expand the synonym; this would give us
instance Monoid a => Monoid (ReaderT r Identity a)
but now we would fall afowl of the other part of the error, namely:
All instance types must be of the form (T t1 ... tn)
Specifically, Identity is not a type variable, so it doesn't fit this form. Again this restriction is in place primarily for historical reasons. You can remove both restrictions by enabling two language extensions:
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE FlexibleInstances #-}
However, in this case it's not needed. The preferable way is to actually use the prescribed form of instance declaration, so:
instance (Applicative f, Monoid m) => Monoid (ReaderT r f m) where
mempty = pure mempty
mappend = liftA2 mappend
This requires no extensions, and works not just for Reader but for ReaderT transforming any Applicative instance.
However it does make an orphan instance; hence you should consider writing another newtype wrapper.
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-- or, instead of GeneralizedNewtypeDeriving, write the obvious instances by hand
newtype App f m = App { getApp :: f m } deriving (Functor, Applicative)
instance (Applicative f, Monoid m) => Monoid (App f m) where
mempty = pure mempty
mappend = liftA2 mappend
Then you can use App (Reader r) a as a monoid whenever a is a monoid. I seem to recall this existed somewhere in the standard libraries already, but I can't find it any more...
The issue here is that your Reader is a type alias instead of a newtype.
Using the former is disallowed by Haskell2010 (which is very conservative in what it is allowed), but GHC allows using type aliases in instances if you turn on the extension reported in the error you posted. Note that in such case it would define an instance for the expansion of the alias, e.g.
instance Monoid a => Monoid (r -> a) where ...
For a Reader type, I'd prefer to use a newtype, even if one needs to wrap/unwrap it when it is used.
I'm learning Haskell and trying to do exercises from book Haskell Programming from first principles and I'm stack trying to write applicative for Pair type
data Pair a = Pair a a deriving Show
I have seen some other examples on web but I'm trying somewhat different applicative functor, I'm trying to utilize monoidal structure of this type. Here is what I have
data Pair a = Pair a a deriving (Show, Eq)
instance Functor Pair where
fmap f (Pair x y) = Pair (f x) (f y)
instance Semigroup a => Semigroup (Pair a) where
(Pair x y) <> (Pair x' y') = Pair (x <> x') (y <> y')
instance Applicative Pair where
pure x = Pair x x
(Pair f g) <*> p = fmap f p <> fmap g p
Unfortunately this will not compile:
* No instance for (Semigroup b) arising from a use of `<>'
Possible fix:
add (Semigroup b) to the context of
the type signature for:
(<*>) :: forall a b. Pair (a -> b) -> Pair a -> Pair b
* In the expression: fmap f p <> fmap g p
In an equation for `<*>': (Pair f g) <*> p = fmap f p <> fmap g p
In the instance declaration for `Applicative Pair'
And this is where I'm stack; I don't see how can I add typeclass constraint to Applicative definition and I thought that making type Pair instance of Semigroup is enough.
Other solutions that I have seen are like
Pair (f g) <*> Pair x y = Pair (f x) (g y)
but these solutions don't utilize monoidal part of Pair type
Is it even possible to make this applicative the way I't trying?
Although it's true that Applicative is the class representing monoidal functors (specifically, Hask endofunctors which are monoidal), Allen&Moronuki present this unfortunately in a way that seems to suggest a direct relation between the Monoid and Applicative classes. There is, in general, no such relation! (The Writer type does define one particular Applicative instance based on the Monoid class, but that's an extremely special case.)
This spawned a rather extended discussion at another SO question.
What the “monoidal” in “monoidal functor” refers to is a monoidal structure on the category's objects, i.e. on Haskell types. Namely, you can combine any two types to a tuple-type. This has per se nothing whatsoever to do with the Monoid class, which is about combining two values of a single type to a value of the same type.
Pair does allow an Applicative instance, but you can't base it on the Semigroup instance, although the definition actually looks quite similar:
instance Applicative Pair where
pure x = Pair x x
Pair f g <*> Pair p q = Pair (f p) (g q)
However, you can now define the Semigroup instance in terms of this:
instance Semigroup a => Semigroup (Pair a) where
(<>) = liftA2 (<>)
That, indeed, is a valid Semigroup instance for any applicative, but it's usually not the definition you want (often, containers have a natural combination operation that never touches the contained elements, e.g. list concatenation).
I don't think that Pair is an Applicative the way you want it to be, Applicative states that
(<*>) :: f (a -> b) -> f a -> f b
should work for all functions in first position whereas you want
(<*>) :: Semigroup b => f (a -> b) -> f a -> f b.
If Pair was always a Semigroup (like Maybe or List for example) your reasoning would be sound, but you need the pre-requisite of the Pair-containee to be Semigroup.
Correct: Pair can't be made an Applicative in the way you want, because Applicative f demands that f a "feel applicative-y" for any a, even non-Semigroup as. Consider writing an alternative class and implementing it:
class CApplicative f where
type C f
pure :: C f a => a -> f a
app :: C f b => f (a -> b) -> f a -> f b
instance CApplicative Pair where
type C Pair = Semigroup
pure x = Pair x x
app (Pure f g) p = fmap f p <> fmap g p
This can be derive since base 4.17.0.0, which includes the via types Generically and Generically1. This will derive the same instances as leftaroundabout writes:
{-# Language DeriveGeneric #-}
{-# Language DerivingStrategies #-}
{-# Language DerivingVia #-}
import Data.Monoid
import GHC.Generics
data Pair a = Pair a a
deriving
stock (Generic, Generic1)
deriving (Semigroup, Monoid)
via Generically (Pair a)
deriving (Functor, Applicative)
via Generically1 Pair
Alternatively you can lift Semigroup and Monoid through the Applicative
deriving (Semigroup, Monoid, Num)
via Ap Pair a
This might apply for any type class, but lets do it for Functors as I know them better. I wan't to construct this list.
l = [Just 1, [1,2,3], Nothing, Right 4]
and then
map (fmap (+1)) l
to get
[Just 2, [2,3,4], Nothing, Right 5]
I know they are all Functors that contain Ints so it might be possible. How can I do this?
Edit
This is turning out to be messier than it would seem. In Java or C# you'd declare the IFunctor interface and then just write
List<IFunctor> l = new List<IFunctor> () {
new Just (1),
new List<Int>() {1,2,3},
new Nothing<Int>(),
new Right (5)
}
assuming Maybe, List and Either implement the IFunctor. Naturally Just and Nothing extend Maybe and Right and Left extend Either. Not satisfied with this problem being easier to resolve on these languages!!!
There should cleaner way in Haskell :(
In Haskell, downcasting is not allowed. You can use AnyFunctor, but the trouble with that is there is no longer any way to get back to a functor that you know. When you have an AnyFunctor a, all you know is that you have an f a for some f, so all you can do is fmap (getting you another AnyFunctor). Thus, AnyFunctor a is in fact equivalent to ().
You can add structure to AnyFunctor to make it more useful, and we'll see a bit of that later on.
Functor Coproducts
But first, I'll share the way that I would probably end up doing this in a real program: by using functor combinators.
{-# LANGUAGE TypeOperators #-}
infixl 1 :+: -- declare this to be a left-associative operator
data (f :+: g) a = FLeft (f a) | FRight (g a)
instance (Functor f, Functor g) => Functor (f :+: g) where
-- left as an exercise
As the data type reads, f :+: g is a functor whose values can be either f a or g a.
Then you can use, for example:
l :: [ (Maybe :+: []) Int ]
l = [ FLeft (Just 1), FRight [2,3,4], FLeft Nothing ]
And you can observe by pattern matching:
getMaybe :: (Maybe :+: g) a -> Maybe a
getMaybe (FLeft v) = v
getMaybe (FRight _) = Nothing
It gets ugly as you add more functors:
l :: [ (Maybe :+: [] :+: Either Int) Int ]
l = [ FLeft (FLeft Nothing), FRight (Right 42) ]
-- Remember that we declared :+: left-associative.
But I recommend it as long as you can handle the ugliness, because it tracks the list of possible functors in the type, which is an advantage. (Perhaps you eventually need more structure beyond what Functor can provide; as long as you can provide it for (:+:), you're in good territory.)
You can make the terms a bit cleaner by creating an explicit union, as Ganesh recommends:
data MyFunctors a
= FMaybe (Maybe a)
| FList [a]
| FEitherInt (Either Int a)
| ...
But you pay by having to re-implement Functor for it ({-# LANGUAGE DeriveFunctor #-} can help). I prefer to put up with the ugliness, and work at a high enough level of abstraction where it doesn't get too ugly (i.e. once you start writing FLeft (FLeft ...) it's time to refactor & generalize).
Coproduct can be found in the comonad-transformers package if you don't want to implement it yourself (it's good exercise though). Other common functor combinators are in the Data.Functor. namespace in the transformers package.
Existentials with Downcasting
AnyFunctor can also be extended to allow downcasting. Downcasting must be explicitly enabled by adding the Typeable class to whatever you intend to downcast. Every concrete type is an instance of Typeable; type constructors are instances of Typeable1 (1 argument); etc. But it doesn't come for free on type variables, so you need to add class constraints. So the AnyFunctor solution becomes:
{-# LANGUAGE GADTs #-}
import Data.Typeable
data AnyFunctor a where
AnyFunctor :: (Functor f, Typeable1 f) => f a -> AnyFunctor a
instance Functor AnyFunctor where
fmap f (AnyFunctor v) = AnyFunctor (fmap f v)
Which allows downcasting:
downcast :: (Typeable1 f, Typeable a) => AnyFunctor a -> Maybe (f a)
downcast (AnyFunctor f) = cast f
This solution is actually cleaner than I had expected to be, and may be worth pursuing.
One approach is to use existentials:
{-# LANGUAGE GADTs #-}
data AnyFunctor v where
AnyFunctor :: Functor f => f v -> AnyFunctor v
instance Functor AnyFunctor where
fmap f (AnyFunctor fv) = AnyFunctor (fmap f fv)
The input list you ask for in your question isn't possible as it stands because it's not correctly typed, so some wrapping like AnyFunctor is likely to be necessary however you approach it.
You can make the input list by wrapping each value in the AnyFunctor data constructor:
[AnyFunctor (Just 1), AnyFunctor [1,2,3],
AnyFunctor Nothing, AnyFunctor (Right 4)]
Note that when you use fmap (+1) it's a good idea to use an explicit type signature for the 1 to avoid any problems with numeric overloading, e.g. fmap (+(1::Integer)).
The difficulty with AnyFunctor v as it stands is that you can't actually do much with it - you can't even look at the results because it isn't an instance of Show, let alone extract a value for future use.
It's a little tricky to make it into an instance of Show. If we add a Show (f v) constraint to the AnyFunctor data constructor, then the Functor instance stops working because there's no guarantee it'll produce an instance of Show itself. Instead we need to use a sort of "higher-order" typeclass Show1, as discussed in this answer:
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE GADTs #-}
data AnyFunctor v where
AnyFunctor :: (Show1 f, Functor f) => f v -> AnyFunctor v
instance Functor AnyFunctor where
fmap f (AnyFunctor fv) = AnyFunctor (fmap f fv)
data ShowDict a where
ShowDict :: Show a => ShowDict a
class Show1 a where
show1Dict :: ShowDict b -> ShowDict (a b)
instance Show v => Show (AnyFunctor v) where
show (AnyFunctor (v :: f v)) =
case show1Dict ShowDict :: ShowDict (f v) of
ShowDict -> "AnyFunctor (" ++ show v ++ ")"
instance Show1 [] where
show1Dict ShowDict = ShowDict
instance Show1 Maybe where
show1Dict ShowDict = ShowDict
instance Show a => Show1 (Either a) where
show1Dict ShowDict = ShowDict
In ghci this gives the following (I've broken the lines for readability):
*Main> map (fmap (+1)) [AnyFunctor (Just 1), AnyFunctor [1,2,3],
AnyFunctor Nothing, AnyFunctor (Right 4)]
[AnyFunctor (Just 2),AnyFunctor ([2,3,4]),
AnyFunctor (Nothing),AnyFunctor (Right 5)]
The basic idea is to express the idea that a type constructor like Nothing, [] or Either a "preserves" the Show constraint, using the Show1 class to say that Show (f v) is available whenever Show v is available.
The same trick applies with other typeclasses. For example #luqui's answer shows how you can extract values using the Typeable class, which already has a built-in Typeable1 variant. Each type class that you add limits the things that you can put into AnyFunctor, but also means you can do more things with it.
One option would be to create a specific data type for your use case, with the additional advantage of having proper names for things.
Another would be to create a specialized * -> * tuples as:
newtype FTuple4 fa fb fc fd r = FTuple4 (fa r, fb r, fc r, fd r)
deriving (Eq, Ord, Show)
So the tuple is homogeneous in values, but heterogeneous in functors.
Then you can define
instance (Functor fa, Functor fb, Functor fc, Functor fd) =>
Functor (FTuple4 fa fb fc fd) where
fmap f (FTuple4 (a, b, c, d)) =
FTuple4 (fmap f a, fmap f b, fmap f c, fmap f d)
and
main = let ft = FTuple4 (Just 1,
[1,2,3],
Nothing,
Right 4 :: Either String Int)
in print $ fmap (+ 1) ft
With this approach, you can pattern match on the result easily, without losing information about the types of the individual elements, their order etc. And, you can have similar instances for Foldable, Traversable, Applicative etc.
Also you don't need to implement the Functor instance yourself, you can use GHC's deriving extensions, so all you need to write to get all the instances is is just
{-# LANGUAGE DeriveFunctor, DeriveFoldable, DeriveTraversable #-}
import Data.Foldable
import Data.Traversable
newtype FTuple4 fa fb fc fd r = FTuple4 (fa r, fb r, fc r, fd r)
deriving (Eq, Ord, Show, Functor, Foldable, Traversable)
And even this can be further automated for arbitrary length using Template Haskell.
The advantage of this approach is mainly in the fact that it just wraps ordinary tuples, so you can seamlessly switch between (,,,) and FTuple4, if you need.
Another alternative, without having your own data type, would be to use nested functor products, since what you're describing is just a product of 4 functors.
import Data.Functor.Product
main = let ft = Pair (Just 1)
(Pair [1,2,3]
(Pair Nothing
(Right 4 :: Either String Int)
))
(Pair a (Pair b (Pair c d))) = fmap (+ 1) ft
in print (a, b, c, d)
This is somewhat verbose, but you can do much better by creating your own functor product using type operators:
{-# LANGUAGE TypeOperators, DeriveFunctor #-}
data (f :*: g) a = f a :*: g a
deriving (Eq, Ord, Show, Functor)
infixl 1 :*:
main = let a :*: b :*: c :*: d = fmap (+ 1) $ Just 1 :*:
[1,2,3] :*:
Nothing :*:
(Right 4 :: Either String Int)
in print (a, b, c, d)
This gets probably as terse and universal as possible.
I would like to write something like:
{-# LANGUAGE FlexibleContexts,FlexibleInstances #-}
import Data.ByteString.Char8 (ByteString,pack)
import Data.Foldable (Foldable)
class (Show a) => Rows a where
rRepr :: a -> [ByteString]
rRepr = (:[]) . pack . show
instance (Foldable f,Show (f a)) => Rows (f a) where
rRepr = const []
meaning that f a instantiate Rows if f instantiate Foldable and f a instantiate Show. When I run ghc I get:
Constraint is no smaller than the instance head
in the constraint: Show (f a)
(Use -XUndecidableInstances to permit this)
In the instance declaration for `Rows (f a)'
I have two questions:
what "smaller" means in the error and what is the problem?
what is the right way to define what I want without using UndecidableInstances?
Let's play compiler: we have a type (f a) we'd like to see if it is a valid satisfier of a Rows constraint. To do so, we need to dispatch a proof that (f a) satisfies Show (f a) as well. This isn't a problem unless someone writes an
instance Rows (f a) => Show (f a) where ...
in which case I'm back where I began. Encoding an infinite loop like this is sort of foolish, but Haskell statically ensures that it's actually impossible unless you ask for UndecidableInstances.
Normally Haskell ensures that each step of a "resolution chase" reduces the size of the type by at least 1 constructor. This leads to a really simple proof by structural induction that we'll end up with a bare type in a finite number of resolutions.
This is overly restrictive, clearly some instance resolution steps are meaningful, useful, and total even if they don't immediately reduce the constructor tree. This same kind of totality restriction applies in languages like Agda and Coq and often it's a bit of an illustrative challenge to manipulate your algorithm into one which proceeds by structural induction.
So how can we fix it? One way is to lose the Show constraint on the class definition use an instance like Show1 from prelude-extras.
class Show1 f where ...
show1 :: (Show1 f, Show a) => f a -> String -- not an instance definition!
and then have instance (Foldable f, Show1 f, Show a) => Rows (f a) where ... which works in my testing. You can then write a default instance as a standalone function.
defRRepr :: Show a => a -> [ByteString]
defRRepr = (:[]) . pack . show
and use it whenever writing an instance definition for a Showable thing.
The other solution is to use newtype wrappers to allow Haskell to see that a "layer" of resolution has been removed.
instance (Foldable f, Show (f a)) => Rows (FoldableRow f a) where
rRepr = const [] . unFR
newtype FoldableRow f a = FR { unFR :: f a } deriving (Show)