From a307d0757ac12b69c752e35de0d45ab21bf310ef Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Tue, 8 Oct 2019 15:10:33 -0400 Subject: [PATCH] Define a pattern synonym for matching out of sums. --- semantic-tags/src/AST/Element.hs | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/semantic-tags/src/AST/Element.hs b/semantic-tags/src/AST/Element.hs index 7996e2953..a71dc00c3 100644 --- a/semantic-tags/src/AST/Element.hs +++ b/semantic-tags/src/AST/Element.hs @@ -1,6 +1,7 @@ -{-# LANGUAGE AllowAmbiguousTypes, DataKinds, FlexibleInstances, MultiParamTypeClasses, ScopedTypeVariables, TypeApplications, TypeFamilies, TypeOperators, UndecidableInstances #-} +{-# LANGUAGE AllowAmbiguousTypes, DataKinds, FlexibleInstances, MultiParamTypeClasses, PatternSynonyms, ScopedTypeVariables, TypeApplications, TypeFamilies, TypeOperators, UndecidableInstances, ViewPatterns #-} module AST.Element ( Element(..) +, pattern Prj ) where import GHC.Generics @@ -15,6 +16,10 @@ instance (Element' elem sub sup, elem ~ Elem sub sup) => Element sub sup where prj = prj' @elem +pattern Prj :: Element sub sup => sub a -> sup a +pattern Prj sub <- (prj -> Just sub) + + type family Elem sub sup where Elem t t = 'True Elem t (l :+: r) = Elem t l || Elem t r