Data.Maybe.maybe, Data.Bool.bool and Data.Either.either all follow a pattern, which is sometimes called “case analysis”: for each constructor of a given type T, provide me a function from the product of the constructor types to a result type r; and I’ll give you back a function from T to r.
generic-case unifies this pattern and generalises it for any type with an instance of Generic from generics-sop.
Honestly, my main motivation for putting this package together was to have an excuse to play with generics-sop a bit, which is a beautiful library but one I never seem to get a chance to use.
I wonder, if I need to define a new case function, do I need to know its type beforehand or is there some way I can automatically get the type? Can GHC infer it?
Would it be much effort to also provide a generic fold function? Example usage might look like this:
listFoldR :: forall a r. r -> (a -> r -> r) -> [a] -> r
listFoldR = gfoldR @[a]
Thanks! Currently you could do it two ways. You can write out the type signature manually:
maybe :: forall a r. r -> (a -> r) -> Maybe a -> r
maybe = gcaseR @(Maybe a)
Or you can use the ChainsR type from the library:
maybe :: forall a r. ChainsR (Code (Maybe a)) (Maybe a) r
maybe = gcaseR @(Maybe a)
The latter is easier for you (just replace Maybe a with your type), but if you’re writing a library, your downstream users won’t have any idea what the type signature means, in which case you should use the former.
I do wonder if a GHC plugin would be able to rewrite the type inline…
Come to think of it, I should probably provide a nicer type synonym for ChainsR (Code a) a r.
Interesting question about generic folds, I’d have to think about it. What do you imagine the type looking like for, say, Either a b?
To my understanding generics-sop does “non-recusive” (or “shallow”) generic transformations, in the sense that if a type refers to itself, it’s not expanded in the Rep. So I think a fold in this sense would be non-trivial to implement (I’m not even sure it’d be possible), but I’ll think about it more.
type family ChainFold f xs r where
ChainFold _ '[] r = r
ChainFold f (f ': xs) r = r -> ChainFold f xs r
ChainFold f (x ': xs) r = x -> ChainFold f xs r
type family ChainsFold xss a r where
ChainsFold '[] a r = a -> r
ChainsFold (xs ': xss) a r = ChainFold a xs r -> ChainsFold xss a r
But that only works if the type is fully concrete:
ghci> :k! ChainsFold (Code [a]) [a] r
ChainsFold (Code [a]) [a] r :: *
= r -> ChainFold [a] [a, [a]] r -> [a] -> r
ghci> :k! ChainsFold (Code [Int]) [Int] r
ChainsFold (Code [Int]) [Int] r :: *
= r -> (Int -> r -> r) -> [Int] -> r
I eventually managed to make this work, but it’s very fiddly, makes me feel a bit icky for some reason, and, as you pointed out, only works for concrete types.
There is also generic-match on Hackage. Since it also uses generics-sop it would be an interesting exercise to carefully compare the implementation with your generic-case.
Apologies for diverting further from the original fold question, but I have related work in generic-data-functions where I provide a kind of generic foldMap:
genericFoldMapNonSum
:: forall tag a
. ( Generic a, GFoldMapNonSum tag (Rep a)
) => a -> GenericFoldMapM tag
The phantom tag is used to grab a GenericFoldMap instance, which provides the Monoid instance you want to use for each field in your foldMap. Perhaps this sort of approach could be relevant here.
That’s okay. It’s missing a lot of pieces anyway if the goal is to have an automated test suite.
On the topic of testing, here’s another idea: you can use generics to construct your own test cases, for example, to obtain a function testFold which takes a fold-like function, say bool :: Bool -> a -> a -> a, and tests that bool False 0 1 and bool True 0 1 have the expected values. Of course the goal is for testFold to work with arbitrary generic types.
goodMaybe :: r -> (a -> r) -> Maybe a -> r
goodMaybe r f Nothing = r
goodMaybe r f (Just a) = f a
badMaybe :: r -> (a -> r) -> Maybe a -> r
badMaybe r f _ = r
spec :: H.Spec
spec = do
specMaybe @() @Char "goodMaybe" goodMaybe
specMaybe @() @Char "badMaybe" badMaybe