Defining a typeclass instance for *a typeclass instance*

I have defined my own typeclass over the uncons operation

class Uncons container a | container -> a where
    uncons_ :: container -> Maybe (a, container)

I’d like to have an automatic Foldable instance derivation for any type that already instances Uncons. Is there a way for me to locally “force” the kind of Uncons container from * -> Constraint to * -> * for me to be able to drop it into a Foldable instance definition?

Here’s how I would do it with DerivingVia:

{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE QuantifiedConstraints #-}
{-# LANGUAGE UndecidableInstances #-}

import Data.Foldable

class Uncons c a | c -> a where
  uncons :: c -> Maybe (a, c)

toList' :: Uncons c a => c -> [a]
toList' xs = case uncons xs of
  Nothing -> []
  Just (y, ys) -> y : toList' ys

newtype ViaUncons f a = ViaUncons (f a)

instance (forall a. Uncons (f a) a) => Foldable (ViaUncons f) where
  foldr cons nil (ViaUncons xs) = case uncons xs of
    Nothing -> nil
    Just (y, ys) -> cons y (foldr cons nil (ViaUncons ys))

Example of usage:

{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleInstances #-}

data List a = Nil | Cons a (List a)
  deriving (Foldable) via ViaUncons List

instance Uncons (List a) a where
  uncons Nil = Nothing
  uncons (Cons x xs) = Just (x, xs)
1 Like

Are you sure you want to have a kind * for the container? IMO a better way to do it would be to make it * -> * and get rid of the a argument, i.e.

class Uncons f where
  uncons_ :: f a -> Maybe (a, f a)

You can try to define

instance Uncons f => Foldable f

using this new typeclass.

1 Like

Thanks for the code. Learned something new. I was hoping to be able to avoid the need of explicit deriving for any datatype that implements Uncons. But that requirement is mostly a stylistic choice and your approach will work if I continue down this path.

The reason I use a kind * for the container is because that way I can define easily a Uncons instance for data types that aren’t really a container, but sort of are. E.g. Uncons Text Char. If those make sense, will have to see later down the line.

The reason you still have to explicitly derive is that things can get ambiguous very quickly. What if somebody else decides to write a class:

class Splittable container a | container -> a where
  split :: container -> Either (container, container) a

Using this type class you can also define a reasonable Foldable instance.

Users have to make clear in some way which instance they want.

(Also, many types already have manual foldable instances, so for those types your new general instance will overlap)

1 Like