Map over PatternSynonyms args before matching w/ ViewPatterns?

Question

I was recently trying to refactor an ADT -- where the number of constructors has grown combinatorically -- into a backwards-compatible set representation:

data Tag = TagFoo | TagBar !Text | TagBaz !Int ... -- many more
           deriving (Eq, Generic, Ord, Show)

newtype Label = Label (HashSet Tag)
                deriving (Eq, Generic, Show)

To this end, I defined several pattern synonyms to the effect of:

{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE ViewPatterns #-}

pattern Foo :: Label
pattern Foo <- Tags [TagFoo] where
  Foo = Label $ HashSet.singleton TagFoo

-- (let's say a lone TagBar is invalid)

pattern FooWithBar :: Text -> Label
pattern FooWithBar b <- Tags [TagFoo, TagBar b] where
   FooWithBar b = Label $ HashSet.fromList [TagFoo, TagBar b]

with Tags pattern defined as:

 pattern Tags :: [Tag] -> Label
 pattern Tags ts <- ((\(Label ts') -> sort $ HashSet.toList ts') -> ts)

Unfortunately, this form is error prone, as it requires users to provide the [Tag] list in the correct Order. Otherwise, a pattern like Tags [TagBar "x", TagFoo] won't match Label $ HashSet.fromList [TagBar "x", TagFoo]. (Not doing the sort is even worse, though, as then the order of tags would be arbitrary).

Ideally, Haskell (or unordered-containers?) would provide a way to pattern-match elements of a HashSets. But another way could be to map the ts argument of Tags ts pattern through HashSet.fromList and then compare the resulting sets:

pattern Tags ts <- ((\(Label ts') -> ts' == HashSet.fromList ts) -> True)

This is impossible, however, because arguments of a pattern synonym cannot be used by a view pattern function. But trying to do the transformation outside of the view function:

pattern Tags ts <- ((\(Label ts') -> ts') -> HashSet.fromList ts == ts')

is also impossible, since the part after -> is a pattern and doesn't permit function application.

Is there some other way of defining the pattern synonym that would allow this kind of matching?

Answer 1

Does Tags really need to be a pattern? What's wrong with simply providing a function:

toLabel :: [Tags] -> Label

and have users use guards:

someFunction lab | lab == toLabel [TagFoo, TagBar "bar"] = ...