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?
{-# 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)
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.