How to express pattern matching for independent combinations of data values?

Question

data Foo = Bar1
         | Bar2 Foo Foo
         | Bar3 Foo
         | Bar4 Foo Foo Foo

Now, assume someone built a Foo tree and I want to check if the arguments of a Foo value are valid. The rules on the constructor arguments are:

• Bar2 Bar1 Foo
• Bar3 (Bar2|Bar3|Bar4)
• Bar4 Bar1 Bar1 (Bar1|Bar4)

I know the constructor of the value and only want to check the immediate arguments, nothing recursive. Like this:

bar2 Bar1 Bar1      = True
bar2 Bar1 (Bar2 {}) = True
bar2 Bar1 (Bar3 _)  = True
bar2 Bar1 (Bar4 {}) = True
bar2 _ _ = False

And e.g. similarly for Bar4:

bar4 Bar1 Bar1 Bar1      = True
bar4 Bar1 Bar1 (Bar4 {}) = True
bar4 _ _ _ = False

How can I express these conditions most concisely? Listing all combinations is in some cases a bit too much. And to my knowledge an "OR"-syntax for pattern matching doesn't exist.

UPDATE

I adapted Daniel's solution and have come to this:

data Foo = Bar1
         | Bar2 Foo Foo
         | Bar3 Foo
         | Bar4 Foo Foo Foo
         deriving (Data, Typeable)

bar2 a b = a `isOf` [Bar1] && b `isOf` [Bar1,Bar2{},Bar3{},Bar4{}]
bar4 a b c = [a,b] `areOf` [Bar1] && c `isOf` [Bar1,Bar4{}]

isOf l r = toConstr l `elem` map toConstr r
areOf l r = all (`isOf` r) l

What I like about this is that I don't have to change my data type, except adding the deriving clause, and that it's readable. The disadvantage of course is that these are dynamic checks. In my case this is fine though as it's just for assert-like checks to discover programming errors.

Answer 1

There is a fine static-checking solution posted; here's a suggestion for a dynamic-checking solution. The key idea is to shy away from pattern-matching and use all the tools we have for writing compact code instead. There's a couple choices for doing this; I'll discuss two. The first is to write isBarX functions for each constructor:

isBar1 (Bar1 {}) = True
isBar1 _ = False

-- ...

isBar4 (Bar4 {}) = True
isBar4 _ = False

valid (Bar1)       = True
valid (Bar2 a b)   = isBar1 a
valid (Bar3 a)     = not (isBar1 a)
valid (Bar4 a b c) = isBar1 a && isBar1 b && (isBar1 c || isBar4 c)

Another option is to write a function that returns some data telling which constructor was used -- say, a custom type like data Constructor = CBar1 | CBar2 | CBar3 | CBar4, or, as I'll do below, something a little hackier, like Int.

constr (Bar1 {}) = 1
constr (Bar2 {}) = 2
constr (Bar3 {}) = 3
constr (Bar4 {}) = 4

valid (Bar1)       = True
valid (Bar2 a b)   = constr a == 1
valid (Bar3 a)     = constr a /= 1
valid (Bar4 a b c) = constr a == 1 && constr b == 1 && constr c `elem` [1,4]

Answer 2

I think the only way how to check that on the type system level is splitting it into several data types. Something like:

data Foo = Foo1 Bar1 | Foo2 Bar2 | Foo3 Bar3 | Foo4 Bar4
data Bar1 = Bar1
data Bar2 = Bar2a Bar1 Foo
data Bar3 = Bar3a Bar2 | Bar3b Bar3 | Bar3c Bar4
data Bar4 = Bar4a Bar1 Bar1 Bar1 | Bar4b Bar1 Bar1 Bar4

You cannot say you want to limit some type variable to certain constructors, so you need to create a new data type for that.

The drawback is that you'll have much more constructors/patterns to type, but that can be solved at least partially by having a few helper functions.

---

Edit: Perhaps another solution would be to use a phantom type for tagging the constructors using GADTs:

{-# LANGUAGE GADTs #-}

data FBar1
data FBar2
data FBar3
data FBar4

data Foo a where
    Bar1 :: Foo FBar1
    Bar2 :: Foo FBar1 -> Foo b -> Foo FBar2
    Bar3a :: Foo FBar2 -> Foo FBar3
    Bar3b :: Foo FBar3 -> Foo FBar3
    Bar3c :: Foo FBar4 -> Foo FBar3
    Bar4a :: Foo FBar1 -> Foo FBar1 -> Foo FBar4
    Bar4b :: Foo FBar1 -> Foo FBar4 -> Foo FBar4

I'm not sure if this solution wouldn't create more problems than it solves. For example it's not possible to write a function like this:

construct :: Int -> FooAny X
construct 0 = Bar1
construct 1 = Bar2 Bar1 Bar1

since X would have to be both FBar1 and FBar2. You'd need existentials for that, for example to wrap it as

data FooAny where
    FooAny :: Foo a -> FooAny

construct :: Int -> FooAny
construct 0 = FooAny $ Bar1
construct 1 = FooAny $ Bar2 Bar1 Bar1