Generic-case: automatic case analysis with no boilerplate

I’m happy to announce a new package candidate: generic-case: Generic case analysis.

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.

Any feedback would be greatly appreciated :slight_smile:

8 Likes

This looks cool!

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?

Maybe a code action for HLS could be added such that it could evaluate type families. Ah, I guess you can already do that in GHCi:

ghci> :k! ChainsR (Code [a]) [a] r
ChainsR (Code [a]) [a] r :: *
= r -> (a -> [a] -> r) -> [a] -> r

Either is not recursive, so a fold over Either has the same type as the case function.

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.

1 Like

Right, I was thinking something like this:

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 think the issue here is that GHC can’t figure out that [a] and a don’t unify:

type family Compare x y where
  Compare a a = True
  Compare a b = False

ghci> :k! Compare [a] a
Compare [a] a :: Bool
= Compare [a] a

I think the issue here is that GHC can’t figure out that [a] and a don’t unify:

see #11424: "Occurs check" not considered when reducing closed type families · Issues · Glasgow Haskell Compiler / GHC · GitLab

2 Likes

Would it be much effort to also provide a generic fold function?

I did this once

with not quite the same types as what you propose, but that’s minor details compared to the trickery to figure out where the recursion is in a Rep.

1 Like

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.

TLDR:

ghci> foldListG [] (:) [1, 2, 3]
[1,2,3]

ghci> foldr (:) [] [1, 2, 3]
[1,2,3]
1 Like

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.

Oops - didn’t come across that in my (admittedly brief) “prior art” research. I’ll take a look!

By the way - I played around (before this post) with using metamorph for testing these polymorphic functions, but couldn’t quite get it to work.

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

See Generic.Data.Function.FoldMap.

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.

That’s actually what I did in the test suite of this library! Complete with generation of the folding functions using QuickCheck’s Fun.

See test/Util for the generic functions, and specBool for example.

For example:

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

Then we get:

  goodMaybe = maybe [✔]
    +++ OK, passed 100 tests.
  badMaybe = maybe [✘]

Failures:

  test/Util.hs:43:3: 
  1) Generics.Case.Maybe badMaybe = maybe
       Falsified (after 1 test and 4 shrinks):
         'a'
         {_->'b'}
         Just ()
         maybe 'a' {_->'b'} (Just ()) = 'b'
         badMaybe 'a' {_->'b'} (Just ()) = 'a'
1 Like

This is cool. I am about to write such a generic deriving for PatternMatchable instances for eDSLs.

Fwiw, PatternMatchable looks like this (I posted an article here):

class PatternMatchable m k p c | m -> k, m p -> c, c -> m p where
  match :: ∀ b. k b => m p -> (c -> m b) -> m b
  be :: ∀ . c -> m p

The code you generated seems very close to match:

maybe :: forall a r. r -> (a -> r) -> Maybe a -> r
maybe = gcaseR @(Maybe a)
1 Like

Isn’t this basically a catamorphism?

If you mean the generic folds above, then yes absolutely. Just a pretty hacky implementation…

Not that it matters much, but this is also sometimes called Church encoding, isn’t it? Still very cool to have the encoding derived for me!