{-# LANGUAGE ViewPatterns, ScopedTypeVariables #-}
{-
Raise an error if you are bracketing an atom, or are enclosed be a list bracket

<TEST>
-- expression bracket reduction
yes = (f x) x -- @Suggestion f x x
no = f (x x)
yes = (foo) -- foo
yes = (foo bar) -- @Suggestion foo bar
yes = foo (bar) -- @Warning bar
yes = foo ((x x)) -- @Suggestion (x x)
yes = (f x) ||| y -- @Suggestion f x ||| y
yes = if (f x) then y else z -- @Suggestion if f x then y else z
yes = if x then (f y) else z -- @Suggestion if x then f y else z
yes = (a foo) :: Int -- @Suggestion a foo :: Int
yes = [(foo bar)] -- @Suggestion [foo bar]
yes = foo ((x y), z) -- @Suggestion (x y, z)
yes = C { f = (e h) } -- @Suggestion C {f = e h}
yes = \ x -> (x && x) -- @Suggestion \x -> x && x
no = \(x -> y) -> z
yes = (`foo` (bar baz)) -- @Suggestion (`foo` bar baz)
yes = f ((x)) -- @Warning x
main = do f; (print x) -- @Suggestion do f print x

-- type bracket reduction
foo :: (Int -> Int) -> Int
foo :: (Maybe Int) -> a -- @Suggestion Maybe Int -> a
instance Named (DeclHead S)
data Foo = Foo {foo :: (Maybe Foo)} -- @Suggestion foo :: Maybe Foo

-- pattern bracket reduction
foo (x:xs) = 1
foo (True) = 1 -- @Warning True
foo ((True)) = 1 -- @Warning True
foo (A{}) = True -- A{}
f x = case x of (Nothing) -> 1; _ -> 2 -- Nothing

-- dollar reduction tests
no = groupFsts . sortFst $ mr
yes = split "to" $ names -- split "to" names
yes = white $ keysymbol -- white keysymbol
yes = operator foo $ operator -- operator foo operator
no = operator foo $ operator bar
yes = return $ Record{a=b}

-- $/bracket rotation tests
yes = (b $ c d) ++ e -- b (c d) ++ e
yes = (a b $ c d) ++ e -- a b (c d) ++ e
no = (f . g $ a) ++ e
no = quickCheck ((\h -> cySucc h == succ h) :: Hygiene -> Bool)
foo = (case x of y -> z; q -> w) :: Int

-- backup fixity resolution
main = do a += b . c; return $ a . b

-- <$> bracket tests
yes = (foo . bar x) <$> baz q -- foo . bar x <$> baz q
no = foo . bar x <$> baz q

-- annotations
main = 1; {-# ANN module ("HLint: ignore Use camelCase" :: String) #-}
main = 1; {-# ANN module (1 + (2)) #-} -- 2

-- special case from esqueleto, see #224
main = operate <$> (select $ from $ \user -> return $ user ^. UserEmail)
-- unknown fixity, see #426
bad x = x . (x +? x . x)
-- special case people don't like to warn on
special = foo $ f{x=1}
special = foo $ Rec{x=1}
special = foo (f{x=1})
</TEST>
-}


module Hint.Bracket(bracketHint) where

import Hint.Type
import Data.Data
import Refact.Types


bracketHint :: DeclHint
bracketHint :: DeclHint
bracketHint _ _ x :: Decl_
x =
    (Exp S -> [Idea]) -> [Exp S] -> [Idea]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\x :: Exp S
x -> (Exp S -> Bool) -> Bool -> Exp S -> [Idea]
forall (a :: * -> *).
(Data (a S), ExactP a, Pretty (a S), Brackets (a S)) =>
(a S -> Bool) -> Bool -> a S -> [Idea]
bracket Exp S -> Bool
isPartialAtom Bool
True Exp S
x [Idea] -> [Idea] -> [Idea]
forall a. [a] -> [a] -> [a]
++ Exp S -> [Idea]
dollar Exp S
x) (Decl_ -> [Exp S]
forall from to. Biplate from to => from -> [to]
childrenBi ((Annotation S -> Annotation S) -> Decl_ -> Decl_
forall from to. Biplate from to => (to -> to) -> from -> from
descendBi Annotation S -> Annotation S
annotations Decl_
x) :: [Exp_]) [Idea] -> [Idea] -> [Idea]
forall a. [a] -> [a] -> [a]
++
    (Type S -> [Idea]) -> [Type S] -> [Idea]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((Type S -> Bool) -> Bool -> Type S -> [Idea]
forall (a :: * -> *).
(Data (a S), ExactP a, Pretty (a S), Brackets (a S)) =>
(a S -> Bool) -> Bool -> a S -> [Idea]
bracket (Bool -> Type S -> Bool
forall a b. a -> b -> a
const Bool
False) Bool
False) (Decl_ -> [Type S]
forall from to. Biplate from to => from -> [to]
childrenBi Decl_
x :: [Type_]) [Idea] -> [Idea] -> [Idea]
forall a. [a] -> [a] -> [a]
++
    (Pat S -> [Idea]) -> [Pat S] -> [Idea]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((Pat S -> Bool) -> Bool -> Pat S -> [Idea]
forall (a :: * -> *).
(Data (a S), ExactP a, Pretty (a S), Brackets (a S)) =>
(a S -> Bool) -> Bool -> a S -> [Idea]
bracket (Bool -> Pat S -> Bool
forall a b. a -> b -> a
const Bool
False) Bool
False) (Decl_ -> [Pat S]
forall from to. Biplate from to => from -> [to]
childrenBi Decl_
x :: [Pat_]) [Idea] -> [Idea] -> [Idea]
forall a. [a] -> [a] -> [a]
++
    (FieldDecl S -> [Idea]) -> [FieldDecl S] -> [Idea]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap FieldDecl S -> [Idea]
fieldDecl (Decl_ -> [FieldDecl S]
forall from to. Biplate from to => from -> [to]
childrenBi Decl_
x)
    where
        -- Brackets at the roots of annotations are fine, so we strip them
        annotations :: Annotation S -> Annotation S
        annotations :: Annotation S -> Annotation S
annotations = (Exp S -> Exp S) -> Annotation S -> Annotation S
forall from to. Biplate from to => (to -> to) -> from -> from
descendBi ((Exp S -> Exp S) -> Annotation S -> Annotation S)
-> (Exp S -> Exp S) -> Annotation S -> Annotation S
forall a b. (a -> b) -> a -> b
$ \x :: Exp S
x -> case (Exp S
x :: Exp_) of
            Paren _ x :: Exp S
x -> Exp S
x
            x :: Exp S
x -> Exp S
x

isPartialAtom :: Exp_ -> Bool
isPartialAtom :: Exp S -> Bool
isPartialAtom x :: Exp S
x = Exp S -> Bool
forall l. Exp l -> Bool
isRecConstr Exp S
x Bool -> Bool -> Bool
|| Exp S -> Bool
forall l. Exp l -> Bool
isRecUpdate Exp S
x

-- Dirty, should add to Brackets type class I think
tyConToRtype :: String -> RType
tyConToRtype :: String -> RType
tyConToRtype "Exp" = RType
Expr
tyConToRtype "Type" = RType
Type
tyConToRtype "Pat"  = RType
Pattern
tyConToRtype _      = RType
Expr

findType :: (Data a) => a -> RType
findType :: a -> RType
findType = String -> RType
tyConToRtype (String -> RType) -> (a -> String) -> a -> RType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DataType -> String
dataTypeName (DataType -> String) -> (a -> DataType) -> a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> DataType
forall a. Data a => a -> DataType
dataTypeOf

-- Just if at least one paren was removed
-- Nothing if zero parens were removed
remParens :: Brackets a => a -> Maybe a
remParens :: a -> Maybe a
remParens = (a -> a) -> Maybe a -> Maybe a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Brackets a => a -> a
go (Maybe a -> Maybe a) -> (a -> Maybe a) -> a -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Maybe a
forall a. Brackets a => a -> Maybe a
remParen
  where
    go :: a -> a
go e :: a
e = a -> (a -> a) -> Maybe a -> a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe a
e a -> a
go (a -> Maybe a
forall a. Brackets a => a -> Maybe a
remParen a
e)

bracket :: forall a . (Data (a S), ExactP a, Pretty (a S), Brackets (a S)) => (a S -> Bool) -> Bool -> a S -> [Idea]
bracket :: (a S -> Bool) -> Bool -> a S -> [Idea]
bracket isPartialAtom :: a S -> Bool
isPartialAtom root :: Bool
root = (Data (a S), ExactP a, Pretty (a S), Brackets (a S)) =>
Maybe (Int, a S, a S -> a S) -> a S -> [Idea]
Maybe (Int, a S, a S -> a S) -> a S -> [Idea]
f Maybe (Int, a S, a S -> a S)
forall a. Maybe a
Nothing
    where
        msg :: String
msg = "Redundant bracket"

        -- f (Maybe (index, parent, gen)) child
        f :: (Data (a S), ExactP a, Pretty (a S), Brackets (a S)) => Maybe (Int,a S,a S -> a S) -> a S -> [Idea]
        f :: Maybe (Int, a S, a S -> a S) -> a S -> [Idea]
f Just{} o :: a S
o@(a S -> Maybe (a S)
forall a. Brackets a => a -> Maybe a
remParens -> Just x :: a S
x) | a S -> Bool
forall a. Brackets a => a -> Bool
isAtom a S
x, Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ a S -> Bool
isPartialAtom a S
x = String -> a S -> a S -> Idea
forall (a :: * -> *) (a :: * -> *).
(Pretty (a S), Pretty (a S), Data (a S), Annotated a,
 Annotated a) =>
String -> a S -> a S -> Idea
bracketError String
msg a S
o a S
x Idea -> [Idea] -> [Idea]
forall a. a -> [a] -> [a]
: a S -> [Idea]
(Data (a S), ExactP a, Pretty (a S), Brackets (a S)) =>
a S -> [Idea]
g a S
x
        f Nothing o :: a S
o@(a S -> Maybe (a S)
forall a. Brackets a => a -> Maybe a
remParens -> Just x :: a S
x) | Bool
root Bool -> Bool -> Bool
|| a S -> Bool
forall a. Brackets a => a -> Bool
isAtom a S
x = (if a S -> Bool
forall a. Brackets a => a -> Bool
isAtom a S
x then String -> a S -> a S -> Idea
forall (a :: * -> *) (a :: * -> *).
(Pretty (a S), Pretty (a S), Data (a S), Annotated a,
 Annotated a) =>
String -> a S -> a S -> Idea
bracketError else String -> a S -> a S -> Idea
forall (a :: * -> *) (a :: * -> *).
(Pretty (a S), Pretty (a S), Data (a S), Annotated a,
 Annotated a) =>
String -> a S -> a S -> Idea
bracketWarning) String
msg a S
o a S
x Idea -> [Idea] -> [Idea]
forall a. a -> [a] -> [a]
: a S -> [Idea]
(Data (a S), ExactP a, Pretty (a S), Brackets (a S)) =>
a S -> [Idea]
g a S
x
        f (Just (i :: Int
i,o :: a S
o,gen :: a S -> a S
gen)) v :: a S
v@(a S -> Maybe (a S)
forall a. Brackets a => a -> Maybe a
remParens -> Just x :: a S
x) | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Int -> a S -> a S -> Bool
forall a. Brackets a => Int -> a -> a -> Bool
needBracket Int
i a S
o a S
x, Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ a S -> Bool
isPartialAtom a S
x =
          String -> a S -> a S -> [Refactoring SrcSpan] -> Idea
forall (ast :: * -> *) a.
(Annotated ast, Pretty a, Pretty (ast S)) =>
String -> ast S -> a -> [Refactoring SrcSpan] -> Idea
suggest String
msg a S
o (a S -> a S
gen a S
x) [Refactoring SrcSpan
r] Idea -> [Idea] -> [Idea]
forall a. a -> [a] -> [a]
: a S -> [Idea]
(Data (a S), ExactP a, Pretty (a S), Brackets (a S)) =>
a S -> [Idea]
g a S
x
          where
            typ :: RType
typ = a S -> RType
forall a. Data a => a -> RType
findType a S
v
            r :: Refactoring SrcSpan
r = RType
-> SrcSpan -> [(String, SrcSpan)] -> String -> Refactoring SrcSpan
forall a. RType -> a -> [(String, a)] -> String -> Refactoring a
Replace RType
typ (a S -> SrcSpan
forall (a :: * -> *). Annotated a => a S -> SrcSpan
toSS a S
v) [("x", a S -> SrcSpan
forall (a :: * -> *). Annotated a => a S -> SrcSpan
toSS a S
x)] "x"
        f _ x :: a S
x = a S -> [Idea]
(Data (a S), ExactP a, Pretty (a S), Brackets (a S)) =>
a S -> [Idea]
g a S
x

        g :: (Data (a S), ExactP a, Pretty (a S), Brackets (a S)) => a S -> [Idea]
        g :: a S -> [Idea]
g o :: a S
o = [[Idea]] -> [Idea]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [(Data (a S), ExactP a, Pretty (a S), Brackets (a S)) =>
Maybe (Int, a S, a S -> a S) -> a S -> [Idea]
Maybe (Int, a S, a S -> a S) -> a S -> [Idea]
f ((Int, a S, a S -> a S) -> Maybe (Int, a S, a S -> a S)
forall a. a -> Maybe a
Just (Int
i,a S
o,a S -> a S
gen)) a S
x | (i :: Int
i,(x :: a S
x,gen :: a S -> a S
gen)) <- [Int] -> [(a S, a S -> a S)] -> [(Int, (a S, a S -> a S))]
forall a b. [a] -> [b] -> [(a, b)]
zip [0..] ([(a S, a S -> a S)] -> [(Int, (a S, a S -> a S))])
-> [(a S, a S -> a S)] -> [(Int, (a S, a S -> a S))]
forall a b. (a -> b) -> a -> b
$ a S -> [(a S, a S -> a S)]
forall on. Uniplate on => on -> [(on, on -> on)]
holes a S
o]

bracketWarning :: String -> a S -> a S -> Idea
bracketWarning msg :: String
msg o :: a S
o x :: a S
x =
  String -> a S -> a S -> [Refactoring SrcSpan] -> Idea
forall (ast :: * -> *) a.
(Annotated ast, Pretty a, Pretty (ast S)) =>
String -> ast S -> a -> [Refactoring SrcSpan] -> Idea
suggest String
msg a S
o a S
x [RType
-> SrcSpan -> [(String, SrcSpan)] -> String -> Refactoring SrcSpan
forall a. RType -> a -> [(String, a)] -> String -> Refactoring a
Replace (a S -> RType
forall a. Data a => a -> RType
findType a S
x) (a S -> SrcSpan
forall (a :: * -> *). Annotated a => a S -> SrcSpan
toSS a S
o) [("x", a S -> SrcSpan
forall (a :: * -> *). Annotated a => a S -> SrcSpan
toSS a S
x)] "x"]
bracketError :: String -> a S -> a S -> Idea
bracketError msg :: String
msg o :: a S
o x :: a S
x =
  String -> a S -> a S -> [Refactoring SrcSpan] -> Idea
forall (ast :: * -> *) a.
(Annotated ast, Pretty a, Pretty (ast S)) =>
String -> ast S -> a -> [Refactoring SrcSpan] -> Idea
warn String
msg a S
o a S
x [RType
-> SrcSpan -> [(String, SrcSpan)] -> String -> Refactoring SrcSpan
forall a. RType -> a -> [(String, a)] -> String -> Refactoring a
Replace (a S -> RType
forall a. Data a => a -> RType
findType a S
x) (a S -> SrcSpan
forall (a :: * -> *). Annotated a => a S -> SrcSpan
toSS a S
o) [("x", a S -> SrcSpan
forall (a :: * -> *). Annotated a => a S -> SrcSpan
toSS a S
x)] "x"]


fieldDecl :: FieldDecl S -> [Idea]
fieldDecl :: FieldDecl S -> [Idea]
fieldDecl o :: FieldDecl S
o@(FieldDecl a :: S
a b :: [Name S]
b v :: Type S
v@(TyParen _ c :: Type S
c))
    = [String
-> FieldDecl S -> FieldDecl S -> [Refactoring SrcSpan] -> Idea
forall (ast :: * -> *) a.
(Annotated ast, Pretty a, Pretty (ast S)) =>
String -> ast S -> a -> [Refactoring SrcSpan] -> Idea
suggest "Redundant bracket" FieldDecl S
o (S -> [Name S] -> Type S -> FieldDecl S
forall l. l -> [Name l] -> Type l -> FieldDecl l
FieldDecl S
a [Name S]
b Type S
c)  [RType
-> SrcSpan -> [(String, SrcSpan)] -> String -> Refactoring SrcSpan
forall a. RType -> a -> [(String, a)] -> String -> Refactoring a
Replace RType
Type (Type S -> SrcSpan
forall (a :: * -> *). Annotated a => a S -> SrcSpan
toSS Type S
v) [("x", Type S -> SrcSpan
forall (a :: * -> *). Annotated a => a S -> SrcSpan
toSS Type S
c)] "x"]]
fieldDecl _ = []


dollar :: Exp_ -> [Idea]
dollar :: Exp S -> [Idea]
dollar = (Exp S -> [Idea]) -> [Exp S] -> [Idea]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Exp S -> [Idea]
f ([Exp S] -> [Idea]) -> (Exp S -> [Exp S]) -> Exp S -> [Idea]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Exp S -> [Exp S]
forall on. Uniplate on => on -> [on]
universe
    where
        f :: Exp S -> [Idea]
f x :: Exp S
x = [String -> Exp S -> Exp S -> [Refactoring SrcSpan] -> Idea
forall (ast :: * -> *) a.
(Annotated ast, Pretty a, Pretty (ast S)) =>
String -> ast S -> a -> [Refactoring SrcSpan] -> Idea
suggest "Redundant $" Exp S
x Exp S
y [Refactoring SrcSpan
r] | InfixApp _ a :: Exp S
a d :: QOp S
d b :: Exp S
b <- [Exp S
x], QOp S -> Exp S
opExp QOp S
d Exp S -> String -> Bool
forall a. Named a => a -> String -> Bool
~= "$"
              ,let y :: Exp S
y = S -> Exp S -> Exp S -> Exp S
forall l. l -> Exp l -> Exp l -> Exp l
App S
an Exp S
a Exp S
b, Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Int -> Exp S -> Exp S -> Bool
forall a. Brackets a => Int -> a -> a -> Bool
needBracket 0 Exp S
y Exp S
a, Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Int -> Exp S -> Exp S -> Bool
forall a. Brackets a => Int -> a -> a -> Bool
needBracket 1 Exp S
y Exp S
b, Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Exp S -> Bool
isPartialAtom Exp S
b
              ,let r :: Refactoring SrcSpan
r = RType
-> SrcSpan -> [(String, SrcSpan)] -> String -> Refactoring SrcSpan
forall a. RType -> a -> [(String, a)] -> String -> Refactoring a
Replace RType
Expr (Exp S -> SrcSpan
forall (a :: * -> *). Annotated a => a S -> SrcSpan
toSS Exp S
x) [("a", Exp S -> SrcSpan
forall (a :: * -> *). Annotated a => a S -> SrcSpan
toSS Exp S
a), ("b", Exp S -> SrcSpan
forall (a :: * -> *). Annotated a => a S -> SrcSpan
toSS Exp S
b)] "a b"]
              [Idea] -> [Idea] -> [Idea]
forall a. [a] -> [a] -> [a]
++
              [String -> Exp S -> Exp S -> [Refactoring SrcSpan] -> Idea
forall (ast :: * -> *) a.
(Annotated ast, Pretty a, Pretty (ast S)) =>
String -> ast S -> a -> [Refactoring SrcSpan] -> Idea
suggest "Move brackets to avoid $" Exp S
x (Exp S -> Exp S
t Exp S
y) [Refactoring SrcSpan
r] |(t :: Exp S -> Exp S
t, e :: Exp S
e@(Paren _ (InfixApp _ a1 :: Exp S
a1 op1 :: QOp S
op1 a2 :: Exp S
a2))) <- Exp S -> [(Exp S -> Exp S, Exp S)]
splitInfix Exp S
x
              ,QOp S -> Exp S
opExp QOp S
op1 Exp S -> String -> Bool
forall a. Named a => a -> String -> Bool
~= "$", Exp S -> Bool
forall l. Exp l -> Bool
isVar Exp S
a1 Bool -> Bool -> Bool
|| Exp S -> Bool
forall l. Exp l -> Bool
isApp Exp S
a1 Bool -> Bool -> Bool
|| Exp S -> Bool
forall l. Exp l -> Bool
isParen Exp S
a1, Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Exp S -> Bool
forall a. Brackets a => a -> Bool
isAtom Exp S
a2
              ,Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Exp S
a1 Exp S -> String -> Bool
forall a. Named a => a -> String -> Bool
~= "select" -- special case for esqueleto, see #224
              , let y :: Exp S
y = S -> Exp S -> Exp S -> Exp S
forall l. l -> Exp l -> Exp l -> Exp l
App S
an Exp S
a1 (S -> Exp S -> Exp S
forall l. l -> Exp l -> Exp l
Paren S
an Exp S
a2)
              , let r :: Refactoring SrcSpan
r = RType
-> SrcSpan -> [(String, SrcSpan)] -> String -> Refactoring SrcSpan
forall a. RType -> a -> [(String, a)] -> String -> Refactoring a
Replace RType
Expr (Exp S -> SrcSpan
forall (a :: * -> *). Annotated a => a S -> SrcSpan
toSS Exp S
e) [("a", Exp S -> SrcSpan
forall (a :: * -> *). Annotated a => a S -> SrcSpan
toSS Exp S
a1), ("b", Exp S -> SrcSpan
forall (a :: * -> *). Annotated a => a S -> SrcSpan
toSS Exp S
a2)] "a (b)" ]
              [Idea] -> [Idea] -> [Idea]
forall a. [a] -> [a] -> [a]
++
              -- special case of (v1 . v2) <$> v3
              [String -> Exp S -> Exp S -> [Refactoring SrcSpan] -> Idea
forall (ast :: * -> *) a.
(Annotated ast, Pretty a, Pretty (ast S)) =>
String -> ast S -> a -> [Refactoring SrcSpan] -> Idea
suggest "Redundant bracket" Exp S
x Exp S
y []
              | InfixApp _ (Paren _ o1 :: Exp S
o1@(InfixApp _ v1 :: Exp S
v1 (QOp S -> Bool
isDot -> Bool
True) v2 :: Exp S
v2)) o2 :: QOp S
o2 v3 :: Exp S
v3 <- [Exp S
x], QOp S -> Exp S
opExp QOp S
o2 Exp S -> String -> Bool
forall a. Named a => a -> String -> Bool
~= "<$>"
              , let y :: Exp S
y = S -> Exp S -> QOp S -> Exp S -> Exp S
forall l. l -> Exp l -> QOp l -> Exp l -> Exp l
InfixApp S
an Exp S
o1 QOp S
o2 Exp S
v3]


-- return both sides, and a way to put them together again
splitInfix :: Exp_ -> [(Exp_ -> Exp_, Exp_)]
splitInfix :: Exp S -> [(Exp S -> Exp S, Exp S)]
splitInfix (InfixApp s :: S
s a :: Exp S
a b :: QOp S
b c :: Exp S
c) = [(S -> Exp S -> QOp S -> Exp S -> Exp S
forall l. l -> Exp l -> QOp l -> Exp l -> Exp l
InfixApp S
s Exp S
a QOp S
b, Exp S
c), (\a :: Exp S
a -> S -> Exp S -> QOp S -> Exp S -> Exp S
forall l. l -> Exp l -> QOp l -> Exp l -> Exp l
InfixApp S
s Exp S
a QOp S
b Exp S
c, Exp S
a)]
splitInfix _ = []