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

    Bool -> [()]
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> [()]) -> Bool -> [()]
forall a b. (a -> b) -> a -> b
$ String
v1 String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
v2 Bool -> Bool -> Bool
&& Bool -> Bool
not ([GenLocated SrcSpanAnnA (HsExpr GhcPs)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [GenLocated SrcSpanAnnA (HsExpr GhcPs)]
l) Bool -> Bool -> Bool
&& ([GenLocated SrcSpanAnnA (HsExpr GhcPs)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [GenLocated SrcSpanAnnA (HsExpr GhcPs)]
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1 Bool -> Bool -> Bool
|| [GenLocated SrcSpanAnnA (HsExpr GhcPs)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [GenLocated SrcSpanAnnA (HsExpr GhcPs)]
r Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1) Bool -> Bool -> Bool
&& String -> Set String -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.notMember String
v1 ((OccName -> String) -> Set OccName -> Set String
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map OccName -> String
occNameString ([GenLocated SrcSpanAnnA (HsExpr GhcPs)] -> Set OccName
forall a. FreeVars a => a -> Set OccName
freeVars ([GenLocated SrcSpanAnnA (HsExpr GhcPs)] -> Set OccName)
-> [GenLocated SrcSpanAnnA (HsExpr GhcPs)] -> Set OccName
forall a b. (a -> b) -> a -> b
$ Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> [GenLocated SrcSpanAnnA (HsExpr GhcPs)]
forall a. Maybe a -> [a]
maybeToList Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs))
hintRuleSide [GenLocated SrcSpanAnnA (HsExpr GhcPs)]
-> [GenLocated SrcSpanAnnA (HsExpr GhcPs)]
-> [GenLocated SrcSpanAnnA (HsExpr GhcPs)]
forall a. [a] -> [a] -> [a]
++ [GenLocated SrcSpanAnnA (HsExpr GhcPs)]
l [GenLocated SrcSpanAnnA (HsExpr GhcPs)]
-> [GenLocated SrcSpanAnnA (HsExpr GhcPs)]
-> [GenLocated SrcSpanAnnA (HsExpr GhcPs)]
forall a. [a] -> [a] -> [a]
++ [GenLocated SrcSpanAnnA (HsExpr GhcPs)]
r))
    if Bool -> Bool
not ([GenLocated SrcSpanAnnA (HsExpr GhcPs)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [GenLocated SrcSpanAnnA (HsExpr GhcPs)]
r) then
      [ HintRule
m{ hintRuleLHS=extendInstances (dotApps l), hintRuleRHS=extendInstances (dotApps r), hintRuleSide=extendInstances <$> hintRuleSide }
      , HintRule
m{ hintRuleLHS=extendInstances (dotApps (l ++ [strToVar v1])), hintRuleRHS=extendInstances (dotApps (r ++ [strToVar v1])), hintRuleSide=extendInstances <$> hintRuleSide } ]
      else if [GenLocated SrcSpanAnnA (HsExpr GhcPs)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [GenLocated SrcSpanAnnA (HsExpr GhcPs)]
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1 then
            [ HintRule
m{ hintRuleLHS=extendInstances (dotApps l), hintRuleRHS=extendInstances (strToVar "id"), hintRuleSide=extendInstances <$> hintRuleSide }
            , HintRule
m{ hintRuleLHS=extendInstances (dotApps (l++[strToVar v1])), hintRuleRHS=extendInstances (strToVar v1), hintRuleSide=extendInstances <$> 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 (LHsExpr GhcPs -> Var_
GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Var_
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)) = ([GenLocated SrcSpanAnnA (HsExpr GhcPs)]
 -> [GenLocated SrcSpanAnnA (HsExpr GhcPs)])
-> ([GenLocated SrcSpanAnnA (HsExpr GhcPs)], String)
-> ([GenLocated SrcSpanAnnA (HsExpr GhcPs)], String)
forall a a' b. (a -> a') -> (a, b) -> (a', b)
first (LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
ls GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> [GenLocated SrcSpanAnnA (HsExpr GhcPs)]
-> [GenLocated SrcSpanAnnA (HsExpr GhcPs)]
forall a. a -> [a] -> [a]
:) (([GenLocated SrcSpanAnnA (HsExpr GhcPs)], String)
 -> ([GenLocated SrcSpanAnnA (HsExpr GhcPs)], String))
-> [([GenLocated SrcSpanAnnA (HsExpr GhcPs)], String)]
-> [([GenLocated SrcSpanAnnA (HsExpr GhcPs)], String)]
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
GenLocated SrcSpanAnnA (HsExpr 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 = GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall a. Brackets a => a -> a
addParen (SrcSpanAnnA
-> HsExpr GhcPs -> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l (XSectionL GhcPs -> LHsExpr GhcPs -> LHsExpr GhcPs -> HsExpr GhcPs
forall p. XSectionL p -> LHsExpr p -> LHsExpr p -> HsExpr p
SectionL XSectionL GhcPs
EpAnn NoEpAnns
forall ann. EpAnn ann
EpAnnNotUsed LHsExpr GhcPs
x LHsExpr GhcPs
op)) -- (a == )
      rSec :: GenLocated SrcSpanAnnA (HsExpr GhcPs)
rSec = GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall a. Brackets a => a -> a
addParen (SrcSpanAnnA
-> HsExpr GhcPs -> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l (XSectionR GhcPs -> LHsExpr GhcPs -> LHsExpr GhcPs -> HsExpr GhcPs
forall p. XSectionR p -> LHsExpr p -> LHsExpr p -> HsExpr p
SectionR XSectionR GhcPs
EpAnn NoEpAnns
forall ann. EpAnn ann
EpAnnNotUsed LHsExpr GhcPs
op LHsExpr GhcPs
y)) -- ( == b)
  in (([GenLocated SrcSpanAnnA (HsExpr GhcPs)]
 -> [GenLocated SrcSpanAnnA (HsExpr GhcPs)])
-> ([GenLocated SrcSpanAnnA (HsExpr GhcPs)], String)
-> ([GenLocated SrcSpanAnnA (HsExpr GhcPs)], String)
forall a a' b. (a -> a') -> (a, b) -> (a', b)
first (GenLocated SrcSpanAnnA (HsExpr GhcPs)
lSec GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> [GenLocated SrcSpanAnnA (HsExpr GhcPs)]
-> [GenLocated SrcSpanAnnA (HsExpr GhcPs)]
forall a. a -> [a] -> [a]
:) (([GenLocated SrcSpanAnnA (HsExpr GhcPs)], String)
 -> ([GenLocated SrcSpanAnnA (HsExpr GhcPs)], String))
-> [([GenLocated SrcSpanAnnA (HsExpr GhcPs)], String)]
-> [([GenLocated SrcSpanAnnA (HsExpr GhcPs)], String)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LHsExpr GhcPs -> [([LHsExpr GhcPs], String)]
dotVersion LHsExpr GhcPs
y) [([GenLocated SrcSpanAnnA (HsExpr GhcPs)], String)]
-> [([GenLocated SrcSpanAnnA (HsExpr GhcPs)], String)]
-> [([GenLocated SrcSpanAnnA (HsExpr GhcPs)], String)]
forall a. [a] -> [a] -> [a]
++ (([GenLocated SrcSpanAnnA (HsExpr GhcPs)]
 -> [GenLocated SrcSpanAnnA (HsExpr GhcPs)])
-> ([GenLocated SrcSpanAnnA (HsExpr GhcPs)], String)
-> ([GenLocated SrcSpanAnnA (HsExpr GhcPs)], String)
forall a a' b. (a -> a') -> (a, b) -> (a', b)
first (GenLocated SrcSpanAnnA (HsExpr GhcPs)
rSec GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> [GenLocated SrcSpanAnnA (HsExpr GhcPs)]
-> [GenLocated SrcSpanAnnA (HsExpr GhcPs)]
forall a. a -> [a] -> [a]
:) (([GenLocated SrcSpanAnnA (HsExpr GhcPs)], String)
 -> ([GenLocated SrcSpanAnnA (HsExpr GhcPs)], String))
-> [([GenLocated SrcSpanAnnA (HsExpr GhcPs)], String)]
-> [([GenLocated SrcSpanAnnA (HsExpr GhcPs)], String)]
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 = String -> String -> [Idea] -> [Idea]
forall a. String -> String -> a -> a
timed String
"Hint" String
"Match apply" ([Idea] -> [Idea]) -> [Idea] -> [Idea]
forall a b. (a -> b) -> a -> b
$ [Idea] -> [Idea]
forall a. [a] -> [a]
forceList
    [ (Severity
-> String
-> Located (HsExpr GhcPs)
-> Located (HsExpr GhcPs)
-> [Refactoring SrcSpan]
-> Idea
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) (GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Located (HsExpr GhcPs)
forall a e. LocatedAn a e -> Located e
reLoc GenLocated SrcSpanAnnA (HsExpr GhcPs)
x) (GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Located (HsExpr GhcPs)
forall a e. LocatedAn a e -> Located e
reLoc GenLocated SrcSpanAnnA (HsExpr GhcPs)
y) [Refactoring SrcSpan
r]){ideaNote=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) <- GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> [(Maybe (Int, LHsExpr GhcPs), LHsExpr GhcPs)]
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, LHsExpr GhcPs)
Maybe (Int, GenLocated SrcSpanAnnA (HsExpr GhcPs))
parent LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
x]
    , let r :: Refactoring SrcSpan
r = RType
-> SrcSpan -> [(String, SrcSpan)] -> String -> Refactoring SrcSpan
forall a. RType -> a -> [(String, a)] -> String -> Refactoring a
R.Replace RType
R.Expr (GenLocated SrcSpanAnnA (HsExpr GhcPs) -> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
toSSA GenLocated SrcSpanAnnA (HsExpr GhcPs)
x) [(String, SrcSpan)]
subst (GenLocated SrcSpanAnnA (HsExpr GhcPs) -> String
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 :: LHsBinds GhcPs
cid_binds :: forall pass. ClsInstDecl pass -> LHsBinds pass
cid_binds}))) =
    [(String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
"" (Maybe String -> String) -> Maybe String -> String
forall a b. (a -> b) -> a -> b
$ LHsBind GhcPs -> Maybe String
bindName LHsBind GhcPs
GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs)
xs, LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
x) | GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs)
xs <- Bag (GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs))
-> [GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs)]
forall a. Bag a -> [a]
bagToList LHsBinds GhcPs
Bag (GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs))
cid_binds, GenLocated SrcSpanAnnA (HsExpr GhcPs)
x <- GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs)
-> [GenLocated SrcSpanAnnA (HsExpr GhcPs)]
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 = (GenLocated SrcSpanAnnA (HsExpr GhcPs) -> (String, LHsExpr GhcPs))
-> [GenLocated SrcSpanAnnA (HsExpr GhcPs)]
-> [(String, LHsExpr GhcPs)]
forall a b. (a -> b) -> [a] -> [b]
map (String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
"" (Maybe String -> String) -> Maybe String -> String
forall a b. (a -> b) -> a -> b
$ LHsDecl GhcPs -> Maybe String
declName LHsDecl GhcPs
x,) ([GenLocated SrcSpanAnnA (HsExpr GhcPs)]
 -> [(String, LHsExpr GhcPs)])
-> [GenLocated SrcSpanAnnA (HsExpr GhcPs)]
-> [(String, LHsExpr GhcPs)]
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnA (HsDecl GhcPs)
-> [GenLocated SrcSpanAnnA (HsExpr GhcPs)]
forall from to. Biplate from to => from -> [to]
childrenBi LHsDecl GhcPs
GenLocated SrcSpanAnnA (HsDecl 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
hintRuleLHS :: HintRule -> HsExtendInstances (LHsExpr GhcPs)
hintRuleRHS :: HintRule -> HsExtendInstances (LHsExpr GhcPs)
hintRuleSide :: HintRule -> Maybe (HsExtendInstances (LHsExpr GhcPs))
hintRuleSeverity :: HintRule -> Severity
hintRuleName :: HintRule -> String
hintRuleSeverity :: Severity
hintRuleName :: String
hintRuleNotes :: [Note]
hintRuleScope :: Scope
hintRuleLHS :: HsExtendInstances (LHsExpr GhcPs)
hintRuleRHS :: HsExtendInstances (LHsExpr GhcPs)
hintRuleSide :: Maybe (HsExtendInstances (LHsExpr GhcPs))
hintRuleNotes :: HintRule -> [Note]
hintRuleScope :: HintRule -> Scope
..} Maybe (Int, LHsExpr GhcPs)
parent LHsExpr GhcPs
x = do
  let lhs :: GenLocated SrcSpanAnnA (HsExpr GhcPs)
lhs = HsExtendInstances (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall a. HsExtendInstances a -> a
unextendInstances HsExtendInstances (LHsExpr GhcPs)
HsExtendInstances (GenLocated SrcSpanAnnA (HsExpr GhcPs))
hintRuleLHS
      rhs :: GenLocated SrcSpanAnnA (HsExpr GhcPs)
rhs = HsExtendInstances (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall a. HsExtendInstances a -> a
unextendInstances HsExtendInstances (LHsExpr GhcPs)
HsExtendInstances (GenLocated SrcSpanAnnA (HsExpr 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 LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
lhs LHsExpr GhcPs
x
  Subst (GenLocated SrcSpanAnnA (HsExpr GhcPs))
u <- (GenLocated SrcSpanAnnA (HsExpr GhcPs)
 -> GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Bool)
-> Subst (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> Maybe (Subst (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall a. (a -> a -> Bool) -> Subst a -> Maybe (Subst a)
validSubst GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Bool
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 (LHsExpr GhcPs -> LHsExpr GhcPs) -> LHsExpr GhcPs -> LHsExpr GhcPs
forall a b. (a -> b) -> a -> b
$ HsExpr GhcPs -> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall a an. a -> LocatedAn an a
noLocA (XApp GhcPs -> LHsExpr GhcPs -> LHsExpr GhcPs -> HsExpr GhcPs
forall p. XApp p -> LHsExpr p -> LHsExpr p -> HsExpr p
HsApp XApp GhcPs
EpAnn NoEpAnns
forall ann. EpAnn ann
EpAnnNotUsed LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
fun LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
rhs)
           | Bool
otherwise = LHsExpr GhcPs
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 (LHsExpr GhcPs)
Subst (GenLocated SrcSpanAnnA (HsExpr GhcPs))
u LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
rhs'
      noParens :: [String]
noParens = [LHsExpr GhcPs -> String
varToStr (LHsExpr GhcPs -> String) -> LHsExpr GhcPs -> String
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
fromParen LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
x | L SrcSpanAnnA
_ (HsApp XApp GhcPs
_ (LHsExpr GhcPs -> String
varToStr -> String
"_noParen_") LHsExpr GhcPs
x) <- GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> [GenLocated SrcSpanAnnA (HsExpr GhcPs)]
forall on. Uniplate on => on -> [on]
universe GenLocated SrcSpanAnnA (HsExpr GhcPs)
tpl]

  Subst (GenLocated SrcSpanAnnA (HsExpr GhcPs))
u <- Subst (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> Maybe (Subst (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([String] -> Subst (LHsExpr GhcPs) -> Subst (LHsExpr GhcPs)
removeParens [String]
noParens Subst (LHsExpr GhcPs)
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 (LHsExpr GhcPs -> LHsExpr GhcPs) -> LHsExpr GhcPs -> LHsExpr GhcPs
forall a b. (a -> b) -> a -> b
$ LHsExpr GhcPs -> LHsExpr GhcPs
performSpecial (LHsExpr GhcPs -> LHsExpr GhcPs) -> LHsExpr GhcPs -> LHsExpr GhcPs
forall a b. (a -> b) -> a -> b
$ (LHsExpr GhcPs, (GenLocated SrcSpanAnnA (HsExpr GhcPs), [String]))
-> LHsExpr GhcPs
forall a b. (a, b) -> a
fst ((LHsExpr GhcPs, (GenLocated SrcSpanAnnA (HsExpr GhcPs), [String]))
 -> LHsExpr GhcPs)
-> (LHsExpr GhcPs,
    (GenLocated SrcSpanAnnA (HsExpr GhcPs), [String]))
-> LHsExpr GhcPs
forall a b. (a -> b) -> a -> b
$ Subst (LHsExpr GhcPs)
-> LHsExpr GhcPs -> (LHsExpr GhcPs, (LHsExpr GhcPs, [String]))
substitute Subst (LHsExpr GhcPs)
Subst (GenLocated SrcSpanAnnA (HsExpr GhcPs))
u (LHsExpr GhcPs -> (LHsExpr GhcPs, (LHsExpr GhcPs, [String])))
-> LHsExpr GhcPs -> (LHsExpr GhcPs, (LHsExpr GhcPs, [String]))
forall a b. (a -> b) -> a -> b
$ Scope -> Scope -> LHsExpr GhcPs -> LHsExpr GhcPs
unqualify Scope
sa Scope
sb LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
rhs')
  Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ (GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Set OccName
forall a. FreeVars a => a -> Set OccName
freeVars GenLocated SrcSpanAnnA (HsExpr GhcPs)
e Set OccName -> Set OccName -> Set OccName
forall a. Ord a => Set a -> Set a -> Set a
Set.\\ (OccName -> Bool) -> Set OccName -> Set OccName
forall a. (a -> Bool) -> Set a -> Set a
Set.filter (Bool -> Bool
not (Bool -> Bool) -> (OccName -> Bool) -> OccName -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Bool
isUnifyVar (String -> Bool) -> (OccName -> String) -> OccName -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OccName -> String
occNameString) (GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Set OccName
forall a. FreeVars a => a -> Set OccName
freeVars GenLocated SrcSpanAnnA (HsExpr GhcPs)
rhs')) Set OccName -> Set OccName -> Bool
forall a. Ord a => Set a -> Set a -> Bool
`Set.isSubsetOf` GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Set OccName
forall a. FreeVars a => a -> Set OccName
freeVars LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr 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.
  Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not ((GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Bool)
-> [GenLocated SrcSpanAnnA (HsExpr GhcPs)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any LHsExpr GhcPs -> Bool
GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Bool
isLambda ([GenLocated SrcSpanAnnA (HsExpr GhcPs)] -> Bool)
-> [GenLocated SrcSpanAnnA (HsExpr GhcPs)] -> Bool
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> [GenLocated SrcSpanAnnA (HsExpr GhcPs)]
forall on. Uniplate on => on -> [on]
universe GenLocated SrcSpanAnnA (HsExpr GhcPs)
lhs) Bool -> Bool -> Bool
|| Bool -> Bool
not ((GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Bool)
-> [GenLocated SrcSpanAnnA (HsExpr GhcPs)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any LHsExpr GhcPs -> Bool
GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Bool
isQuasiQuoteExpr ([GenLocated SrcSpanAnnA (HsExpr GhcPs)] -> Bool)
-> [GenLocated SrcSpanAnnA (HsExpr GhcPs)] -> Bool
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> [GenLocated SrcSpanAnnA (HsExpr GhcPs)]
forall on. Uniplate on => on -> [on]
universe LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
x)

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

  (Subst (GenLocated SrcSpanAnnA (HsExpr GhcPs))
u, GenLocated SrcSpanAnnA (HsExpr GhcPs)
tpl) <- (Subst (GenLocated SrcSpanAnnA (HsExpr GhcPs)),
 GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> Maybe
     (Subst (GenLocated SrcSpanAnnA (HsExpr GhcPs)),
      GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Subst (GenLocated SrcSpanAnnA (HsExpr GhcPs)),
  GenLocated SrcSpanAnnA (HsExpr GhcPs))
 -> Maybe
      (Subst (GenLocated SrcSpanAnnA (HsExpr GhcPs)),
       GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> (Subst (GenLocated SrcSpanAnnA (HsExpr GhcPs)),
    GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> Maybe
     (Subst (GenLocated SrcSpanAnnA (HsExpr GhcPs)),
      GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall a b. (a -> b) -> a -> b
$ if ((String, GenLocated SrcSpanAnnA (HsExpr GhcPs)) -> Bool)
-> [(String, GenLocated SrcSpanAnnA (HsExpr GhcPs))] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((SrcSpan -> SrcSpan -> Bool
forall a. Eq a => a -> a -> Bool
== SrcSpan
noSrcSpan) (SrcSpan -> Bool)
-> ((String, GenLocated SrcSpanAnnA (HsExpr GhcPs)) -> SrcSpan)
-> (String, GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA (SrcSpanAnnA -> SrcSpan)
-> ((String, GenLocated SrcSpanAnnA (HsExpr GhcPs)) -> SrcSpanAnnA)
-> (String, GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> SrcSpan
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpanAnnA (HsExpr GhcPs) -> SrcSpanAnnA
forall l e. GenLocated l e -> l
getLoc (GenLocated SrcSpanAnnA (HsExpr GhcPs) -> SrcSpanAnnA)
-> ((String, GenLocated SrcSpanAnnA (HsExpr GhcPs))
    -> GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> (String, GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> SrcSpanAnnA
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall a b. (a, b) -> b
snd) (Subst (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> [(String, GenLocated SrcSpanAnnA (HsExpr GhcPs))]
forall a. Subst a -> [(String, a)]
fromSubst Subst (GenLocated SrcSpanAnnA (HsExpr GhcPs))
u) then (Subst (GenLocated SrcSpanAnnA (HsExpr GhcPs))
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 <- LHsExpr GhcPs -> Maybe (LHsExpr GhcPs)
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (LHsExpr GhcPs -> Maybe (LHsExpr GhcPs))
-> LHsExpr GhcPs -> Maybe (LHsExpr GhcPs)
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 (LHsExpr GhcPs -> LHsExpr GhcPs) -> LHsExpr GhcPs -> LHsExpr GhcPs
forall a b. (a -> b) -> a -> b
$ LHsExpr GhcPs -> LHsExpr GhcPs
performSpecial LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
tpl)

  (GenLocated SrcSpanAnnA (HsExpr GhcPs),
 GenLocated SrcSpanAnnA (HsExpr GhcPs), [Note], [(String, SrcSpan)])
-> Maybe
     (GenLocated SrcSpanAnnA (HsExpr GhcPs),
      GenLocated SrcSpanAnnA (HsExpr GhcPs), [Note], [(String, SrcSpan)])
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ( GenLocated SrcSpanAnnA (HsExpr GhcPs)
res, GenLocated SrcSpanAnnA (HsExpr GhcPs)
tpl, [Note]
hintRuleNotes,
         [ (String
s, GenLocated SrcSpanAnnA (HsExpr GhcPs) -> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
toSSA GenLocated SrcSpanAnnA (HsExpr GhcPs)
pos') | (String
s, GenLocated SrcSpanAnnA (HsExpr GhcPs)
pos) <- Subst (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> [(String, GenLocated SrcSpanAnnA (HsExpr GhcPs))]
forall a. Subst a -> [(String, a)]
fromSubst Subst (GenLocated SrcSpanAnnA (HsExpr GhcPs))
u, SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA (GenLocated SrcSpanAnnA (HsExpr GhcPs) -> SrcSpanAnnA
forall l e. GenLocated l e -> l
getLoc GenLocated SrcSpanAnnA (HsExpr GhcPs)
pos) SrcSpan -> SrcSpan -> Bool
forall a. Eq a => a -> a -> Bool
/= SrcSpan
noSrcSpan
                          , let pos' :: GenLocated SrcSpanAnnA (HsExpr GhcPs)
pos' = if String
s String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
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 = Bool
-> (GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Bool)
-> Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True LHsExpr GhcPs -> Bool
GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Bool
bool Maybe (LHsExpr GhcPs)
Maybe (GenLocated SrcSpanAnnA (HsExpr 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 String -> String -> Bool
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 String -> String -> Bool
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 String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"==" = LHsExpr GhcPs -> LHsExpr GhcPs
expr (LHsExpr GhcPs -> LHsExpr GhcPs
fromParen1 LHsExpr GhcPs
x) GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Bool
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 String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"not" = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
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
GenLocated SrcSpanAnnA (HsExpr 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 String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"notIn" = [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and [GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> HsExtendInstances (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall a. a -> HsExtendInstances a
extendInstances (GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall from. Data from => from -> from
stripLocs GenLocated SrcSpanAnnA (HsExpr GhcPs)
x) HsExtendInstances (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> [HsExtendInstances (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
-> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` (GenLocated SrcSpanAnnA (HsExpr GhcPs)
 -> HsExtendInstances (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> [GenLocated SrcSpanAnnA (HsExpr GhcPs)]
-> [HsExtendInstances (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
forall a b. (a -> b) -> [a] -> [b]
map (GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> HsExtendInstances (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall a. a -> HsExtendInstances a
extendInstances (GenLocated SrcSpanAnnA (HsExpr GhcPs)
 -> HsExtendInstances (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> (GenLocated SrcSpanAnnA (HsExpr GhcPs)
    -> GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> HsExtendInstances (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall from. Data from => from -> from
stripLocs) (GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> [GenLocated SrcSpanAnnA (HsExpr GhcPs)]
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 String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"notEq" = Bool -> Bool
not (LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
x GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Bool
forall a. Data a => a -> a -> Bool
`astEq` LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
y)
      bool LHsExpr GhcPs
x | LHsExpr GhcPs -> String
varToStr LHsExpr GhcPs
x String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"noTypeCheck" = Bool
True
      bool LHsExpr GhcPs
x | LHsExpr GhcPs -> String
varToStr LHsExpr GhcPs
x String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"noQuickCheck" = Bool
True
      bool LHsExpr GhcPs
x = String -> Bool
forall a. HasCallStack => String -> a
error (String -> Bool) -> String -> Bool
forall a b. (a -> b) -> a -> b
$ String
"Hint.Match.checkSide, unknown side condition: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ GenLocated SrcSpanAnnA (HsExpr GhcPs) -> String
forall a. Outputable a => a -> String
unsafePrettyPrint LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr 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 (LHsExpr GhcPs -> LHsExpr GhcPs) -> LHsExpr GhcPs -> LHsExpr GhcPs
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 = GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Bool
forall a. Brackets a => a -> Bool
isAtom GenLocated SrcSpanAnnA (HsExpr GhcPs)
x
      isType String
"WHNF" GenLocated SrcSpanAnnA (HsExpr GhcPs)
x = LHsExpr GhcPs -> Bool
isWHNF LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
x
      isType String
"Wildcard" GenLocated SrcSpanAnnA (HsExpr GhcPs)
x = (HsRecFields GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)) -> Bool)
-> [HsRecFields GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
-> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any HsRecFields GhcPs (LHsExpr GhcPs) -> Bool
HsRecFields GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)) -> Bool
hasFieldsDotDot (GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> [HsRecFields GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
forall from to. Biplate from to => from -> [to]
universeBi GenLocated SrcSpanAnnA (HsExpr GhcPs)
x)
      isType String
"Nat" (LHsExpr GhcPs -> Maybe Integer
GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Maybe Integer
asInt -> Just Integer
x) | Integer
x Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
0 = Bool
True
      isType String
"Pos" (LHsExpr GhcPs -> Maybe Integer
GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Maybe Integer
asInt -> Just Integer
x) | Integer
x Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>  Integer
0 = Bool
True
      isType String
"Neg" (LHsExpr GhcPs -> Maybe Integer
GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Maybe Integer
asInt -> Just Integer
x) | Integer
x Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<  Integer
0 = Bool
True
      isType String
"NegZero" (LHsExpr GhcPs -> Maybe Integer
GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Maybe Integer
asInt -> Just Integer
x) | Integer
x Integer -> Integer -> Bool
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 (HsExpr GhcPs -> Constr
forall a. Data a => a -> Constr
toConstr HsExpr GhcPs
x) in
        String
typ String -> String -> Bool
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
_)) = Integer -> Integer
forall a. Num a => a -> a
negate (Integer -> Integer) -> Maybe Integer -> Maybe Integer
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)) )) = Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
x
      asInt (L SrcSpanAnnA
_ (HsOverLit XOverLitE GhcPs
_ (OverLit XOverLit GhcPs
_ (HsIntegral (IL SourceText
_ Bool
_ Integer
x))))) = Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
x
      asInt LHsExpr GhcPs
_ = Maybe Integer
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 = (GenLocated SrcSpanAnnA (HsExpr GhcPs)
 -> GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
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 (GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Var_
forall a b. View a b => a -> b
view -> Var_ String
x) | Just GenLocated SrcSpanAnnA (HsExpr GhcPs)
y <- String
-> [(String, GenLocated SrcSpanAnnA (HsExpr GhcPs))]
-> Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
x [(String, LHsExpr GhcPs)]
[(String, GenLocated SrcSpanAnnA (HsExpr 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
GenLocated SrcSpanAnnA (HsExpr 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
GenLocated SrcSpanAnnA (HsExpr GhcPs)
op
        GenLocated SrcSpanAnnA (HsExpr GhcPs)
other -> LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
other) :: LHsExpr GhcPs
   in String
declName String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= LHsExpr GhcPs -> String
varToStr ((LocatedN RdrName -> LocatedN RdrName)
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall from to. Biplate from to => (to -> to) -> from -> from
transformBi LocatedN RdrName -> LocatedN RdrName
unqual (GenLocated SrcSpanAnnA (HsExpr GhcPs)
 -> GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
funOrOp LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr 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 = (GenLocated SrcSpanAnnA (HsExpr GhcPs)
 -> GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall on. Uniplate on => (on -> on) -> on -> on
transform LHsExpr GhcPs -> LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> GenLocated SrcSpanAnnA (HsExpr 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 String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"_noParen_" = GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
fromParen LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr 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 = (LocatedN RdrName -> LocatedN RdrName)
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
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 = LHsExpr GhcPs -> LHsExpr GhcPs
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= (GenLocated SrcSpanAnnA (HsType GhcPs)
 -> GenLocated SrcSpanAnnA (HsType GhcPs))
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall from to. Biplate from to => (to -> to) -> from -> from
transformBi LHsType GhcPs -> LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
-> GenLocated SrcSpanAnnA (HsType 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{}))) =
      HsType GhcPs -> GenLocated SrcSpanAnnA (HsType GhcPs)
forall a an. a -> LocatedAn an a
noLocA (XAppTy GhcPs -> LHsType GhcPs -> LHsType GhcPs -> HsType GhcPs
forall pass.
XAppTy pass -> LHsType pass -> LHsType pass -> HsType pass
HsAppTy XAppTy GhcPs
NoExtField
noExtField LHsType GhcPs
t (HsType GhcPs -> GenLocated SrcSpanAnnA (HsType GhcPs)
forall a an. a -> LocatedAn an a
noLocA (XParTy GhcPs -> LHsType GhcPs -> HsType GhcPs
forall pass. XParTy pass -> LHsType pass -> HsType pass
HsParTy XParTy GhcPs
EpAnn AnnParen
forall ann. EpAnn ann
EpAnnNotUsed LHsType GhcPs
x)))
    f LHsType GhcPs
x = LHsType GhcPs
x