{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
module Retrie.GroundTerms
( GroundTerms
, groundTerms
) where
import Data.HashSet (HashSet)
import qualified Data.HashSet as HashSet
import Retrie.ExactPrint
import Retrie.GHC
import Retrie.Quantifiers
import Retrie.SYB
import Retrie.Types
type GroundTerms = HashSet String
groundTerms :: Data k => Query k v -> GroundTerms
groundTerms :: Query k v -> GroundTerms
groundTerms Query{v
Quantifiers
Annotated k
qResult :: forall ast v. Query ast v -> v
qPattern :: forall ast v. Query ast v -> Annotated ast
qQuantifiers :: forall ast v. Query ast v -> Quantifiers
qResult :: v
qPattern :: Annotated k
qQuantifiers :: Quantifiers
..} = [String] -> GroundTerms
forall a. (Eq a, Hashable a) => [a] -> HashSet a
HashSet.fromList ([String] -> GroundTerms) -> [String] -> GroundTerms
forall a b. (a -> b) -> a -> b
$ k -> [String]
GenericQ [String]
go (k -> [String]) -> k -> [String]
forall a b. (a -> b) -> a -> b
$ Annotated k -> k
forall ast. Annotated ast -> ast
astA Annotated k
qPattern
where
go :: GenericQ [String]
go :: a -> [String]
go a
x
| (Bool -> Bool -> Bool) -> GenericQ Bool -> a -> Bool
forall r. (r -> r -> r) -> GenericQ r -> GenericQ r
everything Bool -> Bool -> Bool
(||) GenericQ Bool
isQuantifier a
x = [[String]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[String]] -> [String]) -> [[String]] -> [String]
forall a b. (a -> b) -> a -> b
$ GenericQ [String] -> a -> [[String]]
forall a u. Data a => (forall d. Data d => d -> u) -> a -> [u]
gmapQ GenericQ [String]
go a
x
| strs :: [String]
strs@(String
_:[String]
_) <- a -> [String]
GenericQ [String]
printer a
x = [String]
strs
| Bool
otherwise = [[String]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[String]] -> [String]) -> [[String]] -> [String]
forall a b. (a -> b) -> a -> b
$ GenericQ [String] -> a -> [[String]]
forall a u. Data a => (forall d. Data d => d -> u) -> a -> [u]
gmapQ GenericQ [String]
go a
x
isQuantifier :: GenericQ Bool
isQuantifier :: a -> Bool
isQuantifier = Bool -> (HsExpr GhcPs -> Bool) -> a -> Bool
forall a b r. (Typeable a, Typeable b) => r -> (b -> r) -> a -> r
mkQ Bool
False HsExpr GhcPs -> Bool
exprIsQ (a -> Bool) -> (HsType GhcPs -> Bool) -> a -> Bool
forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` HsType GhcPs -> Bool
tyIsQ
exprIsQ :: HsExpr GhcPs -> Bool
exprIsQ :: HsExpr GhcPs -> Bool
exprIsQ HsExpr GhcPs
e | Just (L SrcSpan
_ IdP GhcPs
v) <- HsExpr GhcPs -> Maybe (Located (IdP GhcPs))
forall p. HsExpr p -> Maybe (Located (IdP p))
varRdrName HsExpr GhcPs
e = RdrName -> Quantifiers -> Bool
isQ IdP GhcPs
RdrName
v Quantifiers
qQuantifiers
exprIsQ HsExpr GhcPs
_ = Bool
False
tyIsQ :: HsType GhcPs -> Bool
tyIsQ :: HsType GhcPs -> Bool
tyIsQ HsType GhcPs
ty | Just (L SrcSpan
_ IdP GhcPs
v) <- HsType GhcPs -> Maybe (Located (IdP GhcPs))
forall p. HsType p -> Maybe (Located (IdP p))
tyvarRdrName HsType GhcPs
ty = RdrName -> Quantifiers -> Bool
isQ IdP GhcPs
RdrName
v Quantifiers
qQuantifiers
tyIsQ HsType GhcPs
_ = Bool
False
printer :: GenericQ [String]
printer :: a -> [String]
printer = [String] -> (LHsExpr GhcPs -> [String]) -> a -> [String]
forall a b r. (Typeable a, Typeable b) => r -> (b -> r) -> a -> r
mkQ [] LHsExpr GhcPs -> [String]
printExpr (a -> [String]) -> (LHsType GhcPs -> [String]) -> a -> [String]
forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` LHsType GhcPs -> [String]
printTy
anns :: Anns
anns = Annotated k -> Anns
forall ast. Annotated ast -> Anns
annsA Annotated k
qPattern
printExpr :: LHsExpr GhcPs -> [String]
printExpr :: LHsExpr GhcPs -> [String]
printExpr LHsExpr GhcPs
e = [LHsExpr GhcPs -> Anns -> String
forall ast. Annotate ast => Located ast -> Anns -> String
exactPrint LHsExpr GhcPs
e Anns
anns]
printTy :: LHsType GhcPs -> [String]
printTy :: LHsType GhcPs -> [String]
printTy LHsType GhcPs
t = [LHsType GhcPs -> Anns -> String
forall ast. Annotate ast => Located ast -> Anns -> String
exactPrint LHsType GhcPs
t Anns
anns]