{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE RecordWildCards, NamedFieldPuns, TupleSections #-}
{-# LANGUAGE PatternGuards, ViewPatterns, FlexibleContexts #-}

{-
The matching does a fairly simple unification between the two terms, treating
any single letter variable on the left as a free variable. After the matching
we substitute, transform and check the side conditions. We also "see through"
both ($) and (.) functions on the right.

TRANSFORM PATTERNS
_noParen_ - don't bracket this particular item

SIDE CONDITIONS
(&&), (||), not - boolean connectives
isAtom x - does x never need brackets
isFoo x - is the root constructor of x a "Foo"
notEq x y - are x and y not equal
notIn xs ys - are all x variables not in ys expressions
noTypeCheck, noQuickCheck - no semantics, a hint for testing only

($) AND (.)
We see through ($)/(.) by expanding it if nothing else matches.
We also see through (.) by translating rules that have (.) equivalents
to separate rules. For example:

concat (map f x) ==> concatMap f x
-- we spot both these rules can eta reduce with respect to x
concat . map f ==> concatMap f
-- we use the associativity of (.) to add
concat . map f . x ==> concatMap f . x
-- currently 36 of 169 rules have (.) equivalents

We see through (.) if the RHS is dull using id, e.g.

not (not x) ==> x
not . not ==> id
not . not . x ==> x
-}

module Hint.Match(readMatch) where

import Hint.Type (ModuleEx,Idea,idea,ideaNote,toSSA)

import Util
import Timing
import Data.Set qualified as Set
import Refact.Types qualified as R

import Control.Monad
import Data.Tuple.Extra
import Data.Maybe
import Config.Type
import Data.Generics.Uniplate.DataOnly

import GHC.Data.Bag
import GHC.Hs
import GHC.Types.SrcLoc
import GHC.Types.SourceText
import GHC.Types.Name.Reader
import GHC.Types.Name.Occurrence
import Data.Data
import GHC.Util
import Language.Haskell.GhclibParserEx.GHC.Hs.Expr
import Language.Haskell.GhclibParserEx.GHC.Hs.ExtendInstances
import Language.Haskell.GhclibParserEx.GHC.Utils.Outputable
import Language.Haskell.GhclibParserEx.GHC.Types.Name.Reader

readMatch :: [HintRule] -> Scope -> ModuleEx -> LHsDecl GhcPs -> [Idea]
readMatch :: [HintRule] -> Scope -> ModuleEx -> LHsDecl GhcPs -> [Idea]
readMatch [HintRule]
settings = [HintRule] -> Scope -> ModuleEx -> LHsDecl GhcPs -> [Idea]
findIdeas (forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap HintRule -> [HintRule]
readRule [HintRule]
settings)

readRule :: HintRule -> [HintRule]
readRule :: HintRule -> [HintRule]
readRule m :: HintRule
m@HintRule{ hintRuleLHS :: HintRule -> HsExtendInstances (LHsExpr GhcPs)
hintRuleLHS=(forall from. Data from => from -> from
stripLocs forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HsExtendInstances a -> a
unextendInstances -> GenLocated SrcSpanAnnA (HsExpr GhcPs)
hintRuleLHS)
                    , hintRuleRHS :: HintRule -> HsExtendInstances (LHsExpr GhcPs)
hintRuleRHS=(forall from. Data from => from -> from
stripLocs forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HsExtendInstances a -> a
unextendInstances -> GenLocated SrcSpanAnnA (HsExpr GhcPs)
hintRuleRHS)
                    , hintRuleSide :: HintRule -> Maybe (HsExtendInstances (LHsExpr GhcPs))
hintRuleSide=((forall from. Data from => from -> from
stripLocs forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HsExtendInstances a -> a
unextendInstances forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) -> Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs))
hintRuleSide)
                    } =
   (:) HintRule
m{ hintRuleLHS :: HsExtendInstances (LHsExpr GhcPs)
hintRuleLHS=forall a. a -> HsExtendInstances a
extendInstances GenLocated SrcSpanAnnA (HsExpr GhcPs)
hintRuleLHS
        , hintRuleRHS :: HsExtendInstances (LHsExpr GhcPs)
hintRuleRHS=forall a. a -> HsExtendInstances a
extendInstances GenLocated SrcSpanAnnA (HsExpr GhcPs)
hintRuleRHS
        , hintRuleSide :: Maybe (HsExtendInstances (LHsExpr GhcPs))
hintRuleSide=forall a. a -> HsExtendInstances a
extendInstances forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs))
hintRuleSide } forall a b. (a -> b) -> a -> b
$ do
    ([GenLocated SrcSpanAnnA (HsExpr GhcPs)]
l, String
v1) <- LHsExpr GhcPs -> [([LHsExpr GhcPs], String)]
dotVersion GenLocated SrcSpanAnnA (HsExpr GhcPs)
hintRuleLHS
    ([GenLocated SrcSpanAnnA (HsExpr GhcPs)]
r, String
v2) <- LHsExpr GhcPs -> [([LHsExpr GhcPs], String)]
dotVersion GenLocated SrcSpanAnnA (HsExpr GhcPs)
hintRuleRHS

    forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ String
v1 forall a. Eq a => a -> a -> Bool
== String
v2 Bool -> Bool -> Bool
&& Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [GenLocated SrcSpanAnnA (HsExpr GhcPs)]
l) Bool -> Bool -> Bool
&& (forall (t :: * -> *) a. Foldable t => t a -> Int
length [GenLocated SrcSpanAnnA (HsExpr GhcPs)]
l forall a. Ord a => a -> a -> Bool
> Int
1 Bool -> Bool -> Bool
|| forall (t :: * -> *) a. Foldable t => t a -> Int
length [GenLocated SrcSpanAnnA (HsExpr GhcPs)]
r forall a. Ord a => a -> a -> Bool
> Int
1) Bool -> Bool -> Bool
&& forall a. Ord a => a -> Set a -> Bool
Set.notMember String
v1 (forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map OccName -> String
occNameString (forall a. FreeVars a => a -> Set OccName
freeVars forall a b. (a -> b) -> a -> b
$ forall a. Maybe a -> [a]
maybeToList Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs))
hintRuleSide forall a. [a] -> [a] -> [a]
++ [GenLocated SrcSpanAnnA (HsExpr GhcPs)]
l forall a. [a] -> [a] -> [a]
++ [GenLocated SrcSpanAnnA (HsExpr GhcPs)]
r))
    if Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [GenLocated SrcSpanAnnA (HsExpr GhcPs)]
r) then
      [ HintRule
m{ hintRuleLHS :: HsExtendInstances (LHsExpr GhcPs)
hintRuleLHS=forall a. a -> HsExtendInstances a
extendInstances ([LHsExpr GhcPs] -> LHsExpr GhcPs
dotApps [GenLocated SrcSpanAnnA (HsExpr GhcPs)]
l), hintRuleRHS :: HsExtendInstances (LHsExpr GhcPs)
hintRuleRHS=forall a. a -> HsExtendInstances a
extendInstances ([LHsExpr GhcPs] -> LHsExpr GhcPs
dotApps [GenLocated SrcSpanAnnA (HsExpr GhcPs)]
r), hintRuleSide :: Maybe (HsExtendInstances (LHsExpr GhcPs))
hintRuleSide=forall a. a -> HsExtendInstances a
extendInstances forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs))
hintRuleSide }
      , HintRule
m{ hintRuleLHS :: HsExtendInstances (LHsExpr GhcPs)
hintRuleLHS=forall a. a -> HsExtendInstances a
extendInstances ([LHsExpr GhcPs] -> LHsExpr GhcPs
dotApps ([GenLocated SrcSpanAnnA (HsExpr GhcPs)]
l forall a. [a] -> [a] -> [a]
++ [String -> LHsExpr GhcPs
strToVar String
v1])), hintRuleRHS :: HsExtendInstances (LHsExpr GhcPs)
hintRuleRHS=forall a. a -> HsExtendInstances a
extendInstances ([LHsExpr GhcPs] -> LHsExpr GhcPs
dotApps ([GenLocated SrcSpanAnnA (HsExpr GhcPs)]
r forall a. [a] -> [a] -> [a]
++ [String -> LHsExpr GhcPs
strToVar String
v1])), hintRuleSide :: Maybe (HsExtendInstances (LHsExpr GhcPs))
hintRuleSide=forall a. a -> HsExtendInstances a
extendInstances forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs))
hintRuleSide } ]
      else if forall (t :: * -> *) a. Foldable t => t a -> Int
length [GenLocated SrcSpanAnnA (HsExpr GhcPs)]
l forall a. Ord a => a -> a -> Bool
> Int
1 then
            [ HintRule
m{ hintRuleLHS :: HsExtendInstances (LHsExpr GhcPs)
hintRuleLHS=forall a. a -> HsExtendInstances a
extendInstances ([LHsExpr GhcPs] -> LHsExpr GhcPs
dotApps [GenLocated SrcSpanAnnA (HsExpr GhcPs)]
l), hintRuleRHS :: HsExtendInstances (LHsExpr GhcPs)
hintRuleRHS=forall a. a -> HsExtendInstances a
extendInstances (String -> LHsExpr GhcPs
strToVar String
"id"), hintRuleSide :: Maybe (HsExtendInstances (LHsExpr GhcPs))
hintRuleSide=forall a. a -> HsExtendInstances a
extendInstances forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs))
hintRuleSide }
            , HintRule
m{ hintRuleLHS :: HsExtendInstances (LHsExpr GhcPs)
hintRuleLHS=forall a. a -> HsExtendInstances a
extendInstances ([LHsExpr GhcPs] -> LHsExpr GhcPs
dotApps ([GenLocated SrcSpanAnnA (HsExpr GhcPs)]
lforall a. [a] -> [a] -> [a]
++[String -> LHsExpr GhcPs
strToVar String
v1])), hintRuleRHS :: HsExtendInstances (LHsExpr GhcPs)
hintRuleRHS=forall a. a -> HsExtendInstances a
extendInstances (String -> LHsExpr GhcPs
strToVar String
v1), hintRuleSide :: Maybe (HsExtendInstances (LHsExpr GhcPs))
hintRuleSide=forall a. a -> HsExtendInstances a
extendInstances forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs))
hintRuleSide}]
      else []

-- Find a dot version of this rule, return the sequence of app
-- prefixes, and the var.
dotVersion :: LHsExpr GhcPs -> [([LHsExpr GhcPs], String)]
dotVersion :: LHsExpr GhcPs -> [([LHsExpr GhcPs], String)]
dotVersion (forall a b. View a b => a -> b
view -> Var_ String
v) | String -> Bool
isUnifyVar String
v = [([], String
v)]
dotVersion (L SrcSpanAnnA
_ (HsApp XApp GhcPs
_ LHsExpr GhcPs
ls LHsExpr GhcPs
rs)) = forall a a' b. (a -> a') -> (a, b) -> (a', b)
first (LHsExpr GhcPs
ls forall a. a -> [a] -> [a]
:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LHsExpr GhcPs -> [([LHsExpr GhcPs], String)]
dotVersion (GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
fromParen LHsExpr GhcPs
rs)
dotVersion (L SrcSpanAnnA
l (OpApp XOpApp GhcPs
_ LHsExpr GhcPs
x LHsExpr GhcPs
op LHsExpr GhcPs
y)) =
  -- In a GHC parse tree, raw sections aren't valid application terms.
  -- To be suitable as application terms, they must be enclosed in
  -- parentheses.

  --   If a == b then
  --   x is 'a', op is '==' and y is 'b' and,
  let lSec :: GenLocated SrcSpanAnnA (HsExpr GhcPs)
lSec = forall a. Brackets a => a -> a
addParen (forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l (forall p. XSectionL p -> LHsExpr p -> LHsExpr p -> HsExpr p
SectionL forall ann. EpAnn ann
EpAnnNotUsed LHsExpr GhcPs
x LHsExpr GhcPs
op)) -- (a == )
      rSec :: GenLocated SrcSpanAnnA (HsExpr GhcPs)
rSec = forall a. Brackets a => a -> a
addParen (forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l (forall p. XSectionR p -> LHsExpr p -> LHsExpr p -> HsExpr p
SectionR forall ann. EpAnn ann
EpAnnNotUsed LHsExpr GhcPs
op LHsExpr GhcPs
y)) -- ( == b)
  in (forall a a' b. (a -> a') -> (a, b) -> (a', b)
first (GenLocated SrcSpanAnnA (HsExpr GhcPs)
lSec forall a. a -> [a] -> [a]
:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LHsExpr GhcPs -> [([LHsExpr GhcPs], String)]
dotVersion LHsExpr GhcPs
y) forall a. [a] -> [a] -> [a]
++ (forall a a' b. (a -> a') -> (a, b) -> (a', b)
first (GenLocated SrcSpanAnnA (HsExpr GhcPs)
rSec forall a. a -> [a] -> [a]
:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LHsExpr GhcPs -> [([LHsExpr GhcPs], String)]
dotVersion LHsExpr GhcPs
x) -- [([(a ==)], b), ([(b == )], a])].
dotVersion LHsExpr GhcPs
_ = []

---------------------------------------------------------------------
-- PERFORM THE MATCHING

findIdeas :: [HintRule] -> Scope -> ModuleEx -> LHsDecl GhcPs -> [Idea]
findIdeas :: [HintRule] -> Scope -> ModuleEx -> LHsDecl GhcPs -> [Idea]
findIdeas [HintRule]
matches Scope
s ModuleEx
_ LHsDecl GhcPs
decl = forall a. String -> String -> a -> a
timed String
"Hint" String
"Match apply" forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
forceList
    [ (forall a b.
(Outputable a, Outputable b) =>
Severity
-> String
-> Located a
-> Located b
-> [Refactoring SrcSpan]
-> Idea
idea (HintRule -> Severity
hintRuleSeverity HintRule
m) (HintRule -> String
hintRuleName HintRule
m) (forall a e. LocatedAn a e -> Located e
reLoc GenLocated SrcSpanAnnA (HsExpr GhcPs)
x) (forall a e. LocatedAn a e -> Located e
reLoc GenLocated SrcSpanAnnA (HsExpr GhcPs)
y) [Refactoring SrcSpan
r]){ideaNote :: [Note]
ideaNote=[Note]
notes}
    | (String
name, GenLocated SrcSpanAnnA (HsExpr GhcPs)
expr) <- LHsDecl GhcPs -> [(String, LHsExpr GhcPs)]
findDecls LHsDecl GhcPs
decl
    , (Maybe (Int, GenLocated SrcSpanAnnA (HsExpr GhcPs))
parent,GenLocated SrcSpanAnnA (HsExpr GhcPs)
x) <- forall a.
Data a =>
a -> [(Maybe (Int, LHsExpr GhcPs), LHsExpr GhcPs)]
universeParentExp GenLocated SrcSpanAnnA (HsExpr GhcPs)
expr
    , HintRule
m <- [HintRule]
matches, Just (GenLocated SrcSpanAnnA (HsExpr GhcPs)
y, GenLocated SrcSpanAnnA (HsExpr GhcPs)
tpl, [Note]
notes, [(String, SrcSpan)]
subst) <- [Scope
-> String
-> HintRule
-> Maybe (Int, LHsExpr GhcPs)
-> LHsExpr GhcPs
-> Maybe
     (LHsExpr GhcPs, LHsExpr GhcPs, [Note], [(String, SrcSpan)])
matchIdea Scope
s String
name HintRule
m Maybe (Int, GenLocated SrcSpanAnnA (HsExpr GhcPs))
parent GenLocated SrcSpanAnnA (HsExpr GhcPs)
x]
    , let r :: Refactoring SrcSpan
r = forall a. RType -> a -> [(String, a)] -> String -> Refactoring a
R.Replace RType
R.Expr (forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
toSSA GenLocated SrcSpanAnnA (HsExpr GhcPs)
x) [(String, SrcSpan)]
subst (forall a. Outputable a => a -> String
unsafePrettyPrint GenLocated SrcSpanAnnA (HsExpr GhcPs)
tpl)
    ]

-- | A list of root expressions, with their associated names
findDecls :: LHsDecl GhcPs -> [(String, LHsExpr GhcPs)]
findDecls :: LHsDecl GhcPs -> [(String, LHsExpr GhcPs)]
findDecls x :: LHsDecl GhcPs
x@(L SrcSpanAnnA
_ (InstD XInstD GhcPs
_ (ClsInstD XClsInstD GhcPs
_ ClsInstDecl{LHsBinds GhcPs
cid_binds :: forall pass. ClsInstDecl pass -> LHsBinds pass
cid_binds :: LHsBinds GhcPs
cid_binds}))) =
    [(forall a. a -> Maybe a -> a
fromMaybe String
"" forall a b. (a -> b) -> a -> b
$ LHsBind GhcPs -> Maybe String
bindName GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs)
xs, GenLocated SrcSpanAnnA (HsExpr GhcPs)
x) | GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs)
xs <- forall a. Bag a -> [a]
bagToList LHsBinds GhcPs
cid_binds, GenLocated SrcSpanAnnA (HsExpr GhcPs)
x <- forall from to. Biplate from to => from -> [to]
childrenBi GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs)
xs]
findDecls (L SrcSpanAnnA
_ RuleD{}) = [] -- Often rules contain things that HLint would rewrite.
findDecls LHsDecl GhcPs
x = forall a b. (a -> b) -> [a] -> [b]
map (forall a. a -> Maybe a -> a
fromMaybe String
"" forall a b. (a -> b) -> a -> b
$ LHsDecl GhcPs -> Maybe String
declName LHsDecl GhcPs
x,) forall a b. (a -> b) -> a -> b
$ forall from to. Biplate from to => from -> [to]
childrenBi LHsDecl GhcPs
x

matchIdea :: Scope
           -> String
           -> HintRule
           -> Maybe (Int, LHsExpr GhcPs)
           -> LHsExpr GhcPs
           -> Maybe (LHsExpr GhcPs, LHsExpr GhcPs, [Note], [(String, R.SrcSpan)])
matchIdea :: Scope
-> String
-> HintRule
-> Maybe (Int, LHsExpr GhcPs)
-> LHsExpr GhcPs
-> Maybe
     (LHsExpr GhcPs, LHsExpr GhcPs, [Note], [(String, SrcSpan)])
matchIdea Scope
sb String
declName HintRule{String
[Note]
Maybe (HsExtendInstances (LHsExpr GhcPs))
HsExtendInstances (LHsExpr GhcPs)
Scope
Severity
hintRuleScope :: HintRule -> Scope
hintRuleNotes :: HintRule -> [Note]
hintRuleSide :: Maybe (HsExtendInstances (LHsExpr GhcPs))
hintRuleRHS :: HsExtendInstances (LHsExpr GhcPs)
hintRuleLHS :: HsExtendInstances (LHsExpr GhcPs)
hintRuleScope :: Scope
hintRuleNotes :: [Note]
hintRuleName :: String
hintRuleSeverity :: Severity
hintRuleName :: HintRule -> String
hintRuleSeverity :: HintRule -> Severity
hintRuleSide :: HintRule -> Maybe (HsExtendInstances (LHsExpr GhcPs))
hintRuleRHS :: HintRule -> HsExtendInstances (LHsExpr GhcPs)
hintRuleLHS :: HintRule -> HsExtendInstances (LHsExpr GhcPs)
..} Maybe (Int, LHsExpr GhcPs)
parent LHsExpr GhcPs
x = do
  let lhs :: GenLocated SrcSpanAnnA (HsExpr GhcPs)
lhs = forall a. HsExtendInstances a -> a
unextendInstances HsExtendInstances (LHsExpr GhcPs)
hintRuleLHS
      rhs :: GenLocated SrcSpanAnnA (HsExpr GhcPs)
rhs = forall a. HsExtendInstances a -> a
unextendInstances HsExtendInstances (LHsExpr GhcPs)
hintRuleRHS
      sa :: Scope
sa  = Scope
hintRuleScope
      nm :: LocatedN RdrName -> LocatedN RdrName -> Bool
nm LocatedN RdrName
a LocatedN RdrName
b = (Scope, LocatedN RdrName) -> (Scope, LocatedN RdrName) -> Bool
scopeMatch (Scope
sa, LocatedN RdrName
a) (Scope
sb, LocatedN RdrName
b)

  (Subst (GenLocated SrcSpanAnnA (HsExpr GhcPs))
u, Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs))
extra) <- (LocatedN RdrName -> LocatedN RdrName -> Bool)
-> Bool
-> LHsExpr GhcPs
-> LHsExpr GhcPs
-> Maybe (Subst (LHsExpr GhcPs), Maybe (LHsExpr GhcPs))
unifyExp LocatedN RdrName -> LocatedN RdrName -> Bool
nm Bool
True GenLocated SrcSpanAnnA (HsExpr GhcPs)
lhs LHsExpr GhcPs
x
  Subst (GenLocated SrcSpanAnnA (HsExpr GhcPs))
u <- forall a. (a -> a -> Bool) -> Subst a -> Maybe (Subst a)
validSubst forall a. Data a => a -> a -> Bool
astEq Subst (GenLocated SrcSpanAnnA (HsExpr GhcPs))
u

  -- Need to check free vars before unqualification, but after subst
  -- (with 'e') need to unqualify before substitution (with 'res').
  let rhs' :: LHsExpr GhcPs
rhs' | Just GenLocated SrcSpanAnnA (HsExpr GhcPs)
fun <- Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs))
extra = LHsExpr GhcPs -> LHsExpr GhcPs
rebracket1 forall a b. (a -> b) -> a -> b
$ forall a an. a -> LocatedAn an a
noLocA (forall p. XApp p -> LHsExpr p -> LHsExpr p -> HsExpr p
HsApp forall ann. EpAnn ann
EpAnnNotUsed GenLocated SrcSpanAnnA (HsExpr GhcPs)
fun GenLocated SrcSpanAnnA (HsExpr GhcPs)
rhs)
           | Bool
otherwise = GenLocated SrcSpanAnnA (HsExpr GhcPs)
rhs
      (LHsExpr GhcPs
e, (LHsExpr GhcPs
tpl, [String]
substNoParens)) = Subst (LHsExpr GhcPs)
-> LHsExpr GhcPs -> (LHsExpr GhcPs, (LHsExpr GhcPs, [String]))
substitute Subst (GenLocated SrcSpanAnnA (HsExpr GhcPs))
u GenLocated SrcSpanAnnA (HsExpr GhcPs)
rhs'
      noParens :: [String]
noParens = [LHsExpr GhcPs -> String
varToStr forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
fromParen LHsExpr GhcPs
x | L SrcSpanAnnA
_ (HsApp XApp GhcPs
_ (LHsExpr GhcPs -> String
varToStr -> String
"_noParen_") LHsExpr GhcPs
x) <- forall on. Uniplate on => on -> [on]
universe GenLocated SrcSpanAnnA (HsExpr GhcPs)
tpl]

  Subst (GenLocated SrcSpanAnnA (HsExpr GhcPs))
u <- forall (f :: * -> *) a. Applicative f => a -> f a
pure ([String] -> Subst (LHsExpr GhcPs) -> Subst (LHsExpr GhcPs)
removeParens [String]
noParens Subst (GenLocated SrcSpanAnnA (HsExpr GhcPs))
u)

  let res :: LHsExpr GhcPs
res = LHsExpr GhcPs -> LHsExpr GhcPs
addBracketTy (Maybe (Int, LHsExpr GhcPs) -> LHsExpr GhcPs -> LHsExpr GhcPs
addBracket Maybe (Int, LHsExpr GhcPs)
parent forall a b. (a -> b) -> a -> b
$ LHsExpr GhcPs -> LHsExpr GhcPs
performSpecial forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ Subst (LHsExpr GhcPs)
-> LHsExpr GhcPs -> (LHsExpr GhcPs, (LHsExpr GhcPs, [String]))
substitute Subst (GenLocated SrcSpanAnnA (HsExpr GhcPs))
u forall a b. (a -> b) -> a -> b
$ Scope -> Scope -> LHsExpr GhcPs -> LHsExpr GhcPs
unqualify Scope
sa Scope
sb GenLocated SrcSpanAnnA (HsExpr GhcPs)
rhs')
  forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ (forall a. FreeVars a => a -> Set OccName
freeVars GenLocated SrcSpanAnnA (HsExpr GhcPs)
e forall a. Ord a => Set a -> Set a -> Set a
Set.\\ forall a. (a -> Bool) -> Set a -> Set a
Set.filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Bool
isUnifyVar forall b c a. (b -> c) -> (a -> b) -> a -> c
. OccName -> String
occNameString) (forall a. FreeVars a => a -> Set OccName
freeVars GenLocated SrcSpanAnnA (HsExpr GhcPs)
rhs')) forall a. Ord a => Set a -> Set a -> Bool
`Set.isSubsetOf` forall a. FreeVars a => a -> Set OccName
freeVars LHsExpr GhcPs
x
      -- Check no unexpected new free variables.

  -- Check it isn't going to get broken by QuasiQuotes as per #483. If
  -- we have lambdas we might be moving, and QuasiQuotes, we might
  -- inadvertantly break free vars because quasi quotes don't show
  -- what free vars they make use of.
  forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any LHsExpr GhcPs -> Bool
isLambda forall a b. (a -> b) -> a -> b
$ forall on. Uniplate on => on -> [on]
universe GenLocated SrcSpanAnnA (HsExpr GhcPs)
lhs) Bool -> Bool -> Bool
|| Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any LHsExpr GhcPs -> Bool
isQuasiQuoteExpr forall a b. (a -> b) -> a -> b
$ forall on. Uniplate on => on -> [on]
universe LHsExpr GhcPs
x)

  forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ Maybe (LHsExpr GhcPs) -> [(String, LHsExpr GhcPs)] -> Bool
checkSide (forall a. HsExtendInstances a -> a
unextendInstances forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (HsExtendInstances (LHsExpr GhcPs))
hintRuleSide) forall a b. (a -> b) -> a -> b
$ (String
"original", LHsExpr GhcPs
x) forall a. a -> [a] -> [a]
: (String
"result", GenLocated SrcSpanAnnA (HsExpr GhcPs)
res) forall a. a -> [a] -> [a]
: forall a. Subst a -> [(String, a)]
fromSubst Subst (GenLocated SrcSpanAnnA (HsExpr GhcPs))
u
  forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ String -> Maybe (Int, LHsExpr GhcPs) -> LHsExpr GhcPs -> Bool
checkDefine String
declName Maybe (Int, LHsExpr GhcPs)
parent GenLocated SrcSpanAnnA (HsExpr GhcPs)
rhs

  (Subst (GenLocated SrcSpanAnnA (HsExpr GhcPs))
u, GenLocated SrcSpanAnnA (HsExpr GhcPs)
tpl) <- forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ if forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((forall a. Eq a => a -> a -> Bool
== SrcSpan
noSrcSpan) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. SrcSpanAnn' a -> SrcSpan
locA forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall l e. GenLocated l e -> l
getLoc forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) (forall a. Subst a -> [(String, a)]
fromSubst Subst (GenLocated SrcSpanAnnA (HsExpr GhcPs))
u) then (forall a. Monoid a => a
mempty, GenLocated SrcSpanAnnA (HsExpr GhcPs)
res) else (Subst (GenLocated SrcSpanAnnA (HsExpr GhcPs))
u, GenLocated SrcSpanAnnA (HsExpr GhcPs)
tpl)
  GenLocated SrcSpanAnnA (HsExpr GhcPs)
tpl <- forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Scope -> Scope -> LHsExpr GhcPs -> LHsExpr GhcPs
unqualify Scope
sa Scope
sb (Maybe (Int, LHsExpr GhcPs) -> LHsExpr GhcPs -> LHsExpr GhcPs
addBracket Maybe (Int, LHsExpr GhcPs)
parent forall a b. (a -> b) -> a -> b
$ LHsExpr GhcPs -> LHsExpr GhcPs
performSpecial GenLocated SrcSpanAnnA (HsExpr GhcPs)
tpl)

  forall (f :: * -> *) a. Applicative f => a -> f a
pure ( GenLocated SrcSpanAnnA (HsExpr GhcPs)
res, GenLocated SrcSpanAnnA (HsExpr GhcPs)
tpl, [Note]
hintRuleNotes,
         [ (String
s, forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
toSSA GenLocated SrcSpanAnnA (HsExpr GhcPs)
pos') | (String
s, GenLocated SrcSpanAnnA (HsExpr GhcPs)
pos) <- forall a. Subst a -> [(String, a)]
fromSubst Subst (GenLocated SrcSpanAnnA (HsExpr GhcPs))
u, forall a. SrcSpanAnn' a -> SrcSpan
locA (forall l e. GenLocated l e -> l
getLoc GenLocated SrcSpanAnnA (HsExpr GhcPs)
pos) forall a. Eq a => a -> a -> Bool
/= SrcSpan
noSrcSpan
                          , let pos' :: GenLocated SrcSpanAnnA (HsExpr GhcPs)
pos' = if String
s forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
substNoParens then GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
fromParen GenLocated SrcSpanAnnA (HsExpr GhcPs)
pos else GenLocated SrcSpanAnnA (HsExpr GhcPs)
pos
         ]
       )

---------------------------------------------------------------------
-- SIDE CONDITIONS

checkSide :: Maybe (LHsExpr GhcPs) -> [(String, LHsExpr GhcPs)] -> Bool
checkSide :: Maybe (LHsExpr GhcPs) -> [(String, LHsExpr GhcPs)] -> Bool
checkSide Maybe (LHsExpr GhcPs)
x [(String, LHsExpr GhcPs)]
bind = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True LHsExpr GhcPs -> Bool
bool Maybe (LHsExpr GhcPs)
x
    where
      bool :: LHsExpr GhcPs -> Bool
      bool :: LHsExpr GhcPs -> Bool
bool (L SrcSpanAnnA
_ (OpApp XOpApp GhcPs
_ LHsExpr GhcPs
x LHsExpr GhcPs
op LHsExpr GhcPs
y))
        | LHsExpr GhcPs -> String
varToStr LHsExpr GhcPs
op forall a. Eq a => a -> a -> Bool
== String
"&&" = LHsExpr GhcPs -> Bool
bool LHsExpr GhcPs
x Bool -> Bool -> Bool
&& LHsExpr GhcPs -> Bool
bool LHsExpr GhcPs
y
        | LHsExpr GhcPs -> String
varToStr LHsExpr GhcPs
op forall a. Eq a => a -> a -> Bool
== String
"||" = LHsExpr GhcPs -> Bool
bool LHsExpr GhcPs
x Bool -> Bool -> Bool
|| LHsExpr GhcPs -> Bool
bool LHsExpr GhcPs
y
        | LHsExpr GhcPs -> String
varToStr LHsExpr GhcPs
op forall a. Eq a => a -> a -> Bool
== String
"==" = LHsExpr GhcPs -> LHsExpr GhcPs
expr (LHsExpr GhcPs -> LHsExpr GhcPs
fromParen1 LHsExpr GhcPs
x) forall a. Data a => a -> a -> Bool
`astEq` LHsExpr GhcPs -> LHsExpr GhcPs
expr (LHsExpr GhcPs -> LHsExpr GhcPs
fromParen1 LHsExpr GhcPs
y)
      bool (L SrcSpanAnnA
_ (HsApp XApp GhcPs
_ LHsExpr GhcPs
x LHsExpr GhcPs
y)) | LHsExpr GhcPs -> String
varToStr LHsExpr GhcPs
x forall a. Eq a => a -> a -> Bool
== String
"not" = Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ LHsExpr GhcPs -> Bool
bool LHsExpr GhcPs
y
      bool (L SrcSpanAnnA
_ (HsPar XPar GhcPs
_ LHsToken "(" GhcPs
_ LHsExpr GhcPs
x LHsToken ")" GhcPs
_)) = LHsExpr GhcPs -> Bool
bool LHsExpr GhcPs
x

      bool (L SrcSpanAnnA
_ (HsApp XApp GhcPs
_ LHsExpr GhcPs
cond (LHsExpr GhcPs -> LHsExpr GhcPs
sub -> LHsExpr GhcPs
y)))
        | Char
'i' : Char
's' : String
typ <- LHsExpr GhcPs -> String
varToStr LHsExpr GhcPs
cond = String -> GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Bool
isType String
typ LHsExpr GhcPs
y
      bool (L SrcSpanAnnA
_ (HsApp XApp GhcPs
_ (L SrcSpanAnnA
_ (HsApp XApp GhcPs
_ LHsExpr GhcPs
cond (LHsExpr GhcPs -> LHsExpr GhcPs
sub -> LHsExpr GhcPs
x))) (LHsExpr GhcPs -> LHsExpr GhcPs
sub -> LHsExpr GhcPs
y)))
          | LHsExpr GhcPs -> String
varToStr LHsExpr GhcPs
cond forall a. Eq a => a -> a -> Bool
== String
"notIn" = forall (t :: * -> *). Foldable t => t Bool -> Bool
and [forall a. a -> HsExtendInstances a
extendInstances (forall from. Data from => from -> from
stripLocs GenLocated SrcSpanAnnA (HsExpr GhcPs)
x) forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` forall a b. (a -> b) -> [a] -> [b]
map (forall a. a -> HsExtendInstances a
extendInstances forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall from. Data from => from -> from
stripLocs) (forall on. Uniplate on => on -> [on]
universe GenLocated SrcSpanAnnA (HsExpr GhcPs)
y) | GenLocated SrcSpanAnnA (HsExpr GhcPs)
x <- LHsExpr GhcPs -> [LHsExpr GhcPs]
list LHsExpr GhcPs
x, GenLocated SrcSpanAnnA (HsExpr GhcPs)
y <- LHsExpr GhcPs -> [LHsExpr GhcPs]
list LHsExpr GhcPs
y]
          | LHsExpr GhcPs -> String
varToStr LHsExpr GhcPs
cond forall a. Eq a => a -> a -> Bool
== String
"notEq" = Bool -> Bool
not (LHsExpr GhcPs
x forall a. Data a => a -> a -> Bool
`astEq` LHsExpr GhcPs
y)
      bool LHsExpr GhcPs
x | LHsExpr GhcPs -> String
varToStr LHsExpr GhcPs
x forall a. Eq a => a -> a -> Bool
== String
"noTypeCheck" = Bool
True
      bool LHsExpr GhcPs
x | LHsExpr GhcPs -> String
varToStr LHsExpr GhcPs
x forall a. Eq a => a -> a -> Bool
== String
"noQuickCheck" = Bool
True
      bool LHsExpr GhcPs
x = forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"Hint.Match.checkSide, unknown side condition: " forall a. [a] -> [a] -> [a]
++ forall a. Outputable a => a -> String
unsafePrettyPrint LHsExpr GhcPs
x

      expr :: LHsExpr GhcPs -> LHsExpr GhcPs
      expr :: LHsExpr GhcPs -> LHsExpr GhcPs
expr (L SrcSpanAnnA
_ (HsApp XApp GhcPs
_ (LHsExpr GhcPs -> String
varToStr -> String
"subst") LHsExpr GhcPs
x)) = LHsExpr GhcPs -> LHsExpr GhcPs
sub forall a b. (a -> b) -> a -> b
$ LHsExpr GhcPs -> LHsExpr GhcPs
fromParen1 LHsExpr GhcPs
x
      expr LHsExpr GhcPs
x = LHsExpr GhcPs
x

      isType :: String -> GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Bool
isType String
"Compare" GenLocated SrcSpanAnnA (HsExpr GhcPs)
x = Bool
True -- Just a hint for proof stuff
      isType String
"Atom" GenLocated SrcSpanAnnA (HsExpr GhcPs)
x = forall a. Brackets a => a -> Bool
isAtom GenLocated SrcSpanAnnA (HsExpr GhcPs)
x
      isType String
"WHNF" GenLocated SrcSpanAnnA (HsExpr GhcPs)
x = LHsExpr GhcPs -> Bool
isWHNF GenLocated SrcSpanAnnA (HsExpr GhcPs)
x
      isType String
"Wildcard" GenLocated SrcSpanAnnA (HsExpr GhcPs)
x = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any HsRecFields GhcPs (LHsExpr GhcPs) -> Bool
hasFieldsDotDot (forall from to. Biplate from to => from -> [to]
universeBi GenLocated SrcSpanAnnA (HsExpr GhcPs)
x)
      isType String
"Nat" (LHsExpr GhcPs -> Maybe Integer
asInt -> Just Integer
x) | Integer
x forall a. Ord a => a -> a -> Bool
>= Integer
0 = Bool
True
      isType String
"Pos" (LHsExpr GhcPs -> Maybe Integer
asInt -> Just Integer
x) | Integer
x forall a. Ord a => a -> a -> Bool
>  Integer
0 = Bool
True
      isType String
"Neg" (LHsExpr GhcPs -> Maybe Integer
asInt -> Just Integer
x) | Integer
x forall a. Ord a => a -> a -> Bool
<  Integer
0 = Bool
True
      isType String
"NegZero" (LHsExpr GhcPs -> Maybe Integer
asInt -> Just Integer
x) | Integer
x forall a. Ord a => a -> a -> Bool
<= Integer
0 = Bool
True
      isType String
"LitInt" (L SrcSpanAnnA
_ (HsLit XLitE GhcPs
_ HsInt{})) = Bool
True
      isType String
"LitInt" (L SrcSpanAnnA
_ (HsOverLit XOverLitE GhcPs
_ (OverLit XOverLit GhcPs
_ HsIntegral{}))) = Bool
True
      isType String
"LitString" (L SrcSpanAnnA
_ (HsLit XLitE GhcPs
_ HsString{})) = Bool
True
      isType String
"Var" (L SrcSpanAnnA
_ HsVar{}) = Bool
True
      isType String
"App" (L SrcSpanAnnA
_ HsApp{}) = Bool
True
      isType String
"InfixApp" (L SrcSpanAnnA
_ x :: HsExpr GhcPs
x@OpApp{}) = Bool
True
      isType String
"Paren" (L SrcSpanAnnA
_ x :: HsExpr GhcPs
x@HsPar{}) = Bool
True
      isType String
"Tuple" (L SrcSpanAnnA
_ ExplicitTuple{}) = Bool
True

      isType String
typ (L SrcSpanAnnA
_ HsExpr GhcPs
x) =
        let top :: String
top = Constr -> String
showConstr (forall a. Data a => a -> Constr
toConstr HsExpr GhcPs
x) in
        String
typ forall a. Eq a => a -> a -> Bool
== String
top

      asInt :: LHsExpr GhcPs -> Maybe Integer
      asInt :: LHsExpr GhcPs -> Maybe Integer
asInt (L SrcSpanAnnA
_ (HsPar XPar GhcPs
_ LHsToken "(" GhcPs
_ LHsExpr GhcPs
x LHsToken ")" GhcPs
_)) = LHsExpr GhcPs -> Maybe Integer
asInt LHsExpr GhcPs
x
      asInt (L SrcSpanAnnA
_ (NegApp XNegApp GhcPs
_ LHsExpr GhcPs
x SyntaxExpr GhcPs
_)) = forall a. Num a => a -> a
negate forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LHsExpr GhcPs -> Maybe Integer
asInt LHsExpr GhcPs
x
      asInt (L SrcSpanAnnA
_ (HsLit XLitE GhcPs
_ (HsInt XHsInt GhcPs
_ (IL SourceText
_ Bool
_ Integer
x)) )) = forall a. a -> Maybe a
Just Integer
x
      asInt (L SrcSpanAnnA
_ (HsOverLit XOverLitE GhcPs
_ (OverLit XOverLit GhcPs
_ (HsIntegral (IL SourceText
_ Bool
_ Integer
x))))) = forall a. a -> Maybe a
Just Integer
x
      asInt LHsExpr GhcPs
_ = forall a. Maybe a
Nothing

      list :: LHsExpr GhcPs -> [LHsExpr GhcPs]
      list :: LHsExpr GhcPs -> [LHsExpr GhcPs]
list (L SrcSpanAnnA
_ (ExplicitList XExplicitList GhcPs
_ [LHsExpr GhcPs]
xs)) = [LHsExpr GhcPs]
xs
      list LHsExpr GhcPs
x = [LHsExpr GhcPs
x]

      sub :: LHsExpr GhcPs -> LHsExpr GhcPs
      sub :: LHsExpr GhcPs -> LHsExpr GhcPs
sub = forall on. Uniplate on => (on -> on) -> on -> on
transform GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
f
        where f :: GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
f (forall a b. View a b => a -> b
view -> Var_ String
x) | Just GenLocated SrcSpanAnnA (HsExpr GhcPs)
y <- forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
x [(String, LHsExpr GhcPs)]
bind = GenLocated SrcSpanAnnA (HsExpr GhcPs)
y
              f GenLocated SrcSpanAnnA (HsExpr GhcPs)
x = GenLocated SrcSpanAnnA (HsExpr GhcPs)
x

-- Does the result look very much like the declaration?
checkDefine :: String -> Maybe (Int, LHsExpr GhcPs) -> LHsExpr GhcPs -> Bool
checkDefine :: String -> Maybe (Int, LHsExpr GhcPs) -> LHsExpr GhcPs -> Bool
checkDefine String
declName Maybe (Int, LHsExpr GhcPs)
Nothing LHsExpr GhcPs
y =
  let funOrOp :: GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
funOrOp GenLocated SrcSpanAnnA (HsExpr GhcPs)
expr = (case GenLocated SrcSpanAnnA (HsExpr GhcPs)
expr of
        L SrcSpanAnnA
_ (HsApp XApp GhcPs
_ LHsExpr GhcPs
fun LHsExpr GhcPs
_) -> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
funOrOp LHsExpr GhcPs
fun
        L SrcSpanAnnA
_ (OpApp XOpApp GhcPs
_ LHsExpr GhcPs
_ LHsExpr GhcPs
op LHsExpr GhcPs
_) -> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
funOrOp LHsExpr GhcPs
op
        GenLocated SrcSpanAnnA (HsExpr GhcPs)
other -> GenLocated SrcSpanAnnA (HsExpr GhcPs)
other) :: LHsExpr GhcPs
   in String
declName forall a. Eq a => a -> a -> Bool
/= LHsExpr GhcPs -> String
varToStr (forall from to. Biplate from to => (to -> to) -> from -> from
transformBi LocatedN RdrName -> LocatedN RdrName
unqual forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
funOrOp LHsExpr GhcPs
y)
checkDefine String
_ Maybe (Int, LHsExpr GhcPs)
_ LHsExpr GhcPs
_ = Bool
True

---------------------------------------------------------------------
-- TRANSFORMATION

-- If it has '_noParen_', remove the brackets (if exist).
performSpecial :: LHsExpr GhcPs -> LHsExpr GhcPs
performSpecial :: LHsExpr GhcPs -> LHsExpr GhcPs
performSpecial = forall on. Uniplate on => (on -> on) -> on -> on
transform LHsExpr GhcPs -> LHsExpr GhcPs
fNoParen
  where
    fNoParen :: LHsExpr GhcPs -> LHsExpr GhcPs
    fNoParen :: LHsExpr GhcPs -> LHsExpr GhcPs
fNoParen (L SrcSpanAnnA
_ (HsApp XApp GhcPs
_ LHsExpr GhcPs
e LHsExpr GhcPs
x)) | LHsExpr GhcPs -> String
varToStr LHsExpr GhcPs
e forall a. Eq a => a -> a -> Bool
== String
"_noParen_" = GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
fromParen LHsExpr GhcPs
x
    fNoParen LHsExpr GhcPs
x = LHsExpr GhcPs
x

-- Contract : 'Data.List.foo' => 'foo' if 'Data.List' is loaded.
unqualify :: Scope -> Scope -> LHsExpr GhcPs -> LHsExpr GhcPs
unqualify :: Scope -> Scope -> LHsExpr GhcPs -> LHsExpr GhcPs
unqualify Scope
from Scope
to = forall from to. Biplate from to => (to -> to) -> from -> from
transformBi LocatedN RdrName -> LocatedN RdrName
f
  where
    f :: LocatedN RdrName -> LocatedN RdrName
    f :: LocatedN RdrName -> LocatedN RdrName
f x :: LocatedN RdrName
x@(L SrcSpanAnn' (EpAnn NameAnn)
_ (Unqual OccName
s)) | String -> Bool
isUnifyVar (OccName -> String
occNameString OccName
s) = LocatedN RdrName
x
    f LocatedN RdrName
x = (Scope, LocatedN RdrName) -> Scope -> LocatedN RdrName
scopeMove (Scope
from, LocatedN RdrName
x) Scope
to

addBracket :: Maybe (Int, LHsExpr GhcPs) -> LHsExpr GhcPs -> LHsExpr GhcPs
addBracket :: Maybe (Int, LHsExpr GhcPs) -> LHsExpr GhcPs -> LHsExpr GhcPs
addBracket (Just (Int
i, LHsExpr GhcPs
p)) LHsExpr GhcPs
c | Int -> LHsExpr GhcPs -> LHsExpr GhcPs -> Bool
needBracketOld Int
i LHsExpr GhcPs
p LHsExpr GhcPs
c = forall (id :: Pass). LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
nlHsPar LHsExpr GhcPs
c
addBracket Maybe (Int, LHsExpr GhcPs)
_ LHsExpr GhcPs
x = LHsExpr GhcPs
x

-- Type substitution e.g. 'Foo Int' for 'a' in 'Proxy a' can lead to a
-- need to bracket type applications in  This doesn't come up in HSE
-- because the pretty printer inserts them.
addBracketTy :: LHsExpr GhcPs -> LHsExpr GhcPs
addBracketTy :: LHsExpr GhcPs -> LHsExpr GhcPs
addBracketTy= forall from to. Biplate from to => (to -> to) -> from -> from
transformBi LHsType GhcPs -> LHsType GhcPs
f
  where
    f :: LHsType GhcPs -> LHsType GhcPs
    f :: LHsType GhcPs -> LHsType GhcPs
f (L SrcSpanAnnA
_ (HsAppTy XAppTy GhcPs
_ LHsType GhcPs
t x :: LHsType GhcPs
x@(L SrcSpanAnnA
_ HsAppTy{}))) =
      forall a an. a -> LocatedAn an a
noLocA (forall pass.
XAppTy pass -> LHsType pass -> LHsType pass -> HsType pass
HsAppTy NoExtField
noExtField LHsType GhcPs
t (forall a an. a -> LocatedAn an a
noLocA (forall pass. XParTy pass -> LHsType pass -> HsType pass
HsParTy forall ann. EpAnn ann
EpAnnNotUsed LHsType GhcPs
x)))
    f LHsType GhcPs
x = LHsType GhcPs
x