diff --git a/Control/Applicative/QQ/ADo.hs b/Control/Applicative/QQ/ADo.hs index 9f79415..b17173c 100644 --- a/Control/Applicative/QQ/ADo.hs +++ b/Control/Applicative/QQ/ADo.hs @@ -27,6 +27,7 @@ import Language.Haskell.TH.Lib import Language.Haskell.TH.Quote import Language.Haskell.TH.Syntax import Control.Monad +import Data.Data (cast, gmapQ) -- $desugaring -- @@ -121,22 +122,24 @@ applicate rawPatterns stmt = do es failingPattern :: Pat -> Q Bool -failingPattern p = case p of +failingPattern pat = case pat of LitP {} -> return True VarP {} -> return False TupP ps -> anyFailing ps ConP n ps -> liftM2 ((||) . not) (singleCon n) (anyFailing ps) InfixP p n q -> failingPattern $ ConP n [p, q] TildeP {} -> return False - BangP p -> failingPattern p - AsP _ p -> failingPattern p WildP -> return False RecP n fps -> failingPattern $ ConP n (map snd fps) ListP {} -> return True - SigP p _ -> failingPattern p - ViewP _ p -> failingPattern p + -- recurse on any subpatterns + -- we do this implicitly because it avoids referring to the constructors + -- by name, which means we can work with TH versions where they didn't + -- exist + _ -> fmap or . sequence $ gmapQ (mkQ (return False) failingPattern) pat where anyFailing = fmap or . mapM failingPattern + mkQ d f x = maybe d f (cast x) singleCon :: Name -> Q Bool singleCon n = do diff --git a/applicative-quoters.cabal b/applicative-quoters.cabal index b008618..f8c202b 100644 --- a/applicative-quoters.cabal +++ b/applicative-quoters.cabal @@ -17,7 +17,7 @@ License: BSD3 License-file: LICENSE Build-type: Simple -Tested-with: GHC == 7.0.1 +Tested-with: GHC == 6.12.3, GHC == 7.0.1 Library Exposed-modules: @@ -27,7 +27,7 @@ Library Build-depends: base >= 4 && < 4.4, haskell-src-meta >= 0.2 && < 0.4, - template-haskell == 2.5.* + template-haskell >= 2.4 && < 2.6 GHC-options: -Wall