{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE PatternGuards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# OPTIONS_GHC -fno-warn-overlapping-patterns -fno-warn-incomplete-patterns #-}
module Language.Haskell.Exts.Bracket
( Brackets(..)
, paren
, transformBracket
, rebracket1
, appsBracket
) where
import Control.Monad.Trans.State
import Data.Data
import Data.Default
import Data.Generics.Uniplate.Data
import Language.Haskell.Exts.Syntax
import Language.Haskell.Exts.Util.Internal
class Brackets a where
remParen :: a -> Maybe a
addParen :: a -> a
isAtom :: a -> Bool
needBracket :: Int -> a -> a -> Bool
instance (Data l, Default l) => Brackets (Exp l) where
remParen :: Exp l -> Maybe (Exp l)
remParen (Paren _ x :: Exp l
x) = Exp l -> Maybe (Exp l)
forall a. a -> Maybe a
Just Exp l
x
remParen _ = Maybe (Exp l)
forall a. Maybe a
Nothing
addParen :: Exp l -> Exp l
addParen = l -> Exp l -> Exp l
forall l. l -> Exp l -> Exp l
Paren l
forall a. Default a => a
def
isAtom :: Exp l -> Bool
isAtom x :: Exp l
x = case Exp l
x of
Var{} -> Bool
True
Con{} -> Bool
True
Paren{} -> Bool
True
Tuple{} -> Bool
True
List{} -> Bool
True
LeftSection{} -> Bool
True
RightSection{} -> Bool
True
TupleSection{} -> Bool
True
RecConstr{} -> Bool
True
ListComp{} -> Bool
True
EnumFrom{} -> Bool
True
EnumFromTo{} -> Bool
True
EnumFromThen{} -> Bool
True
EnumFromThenTo{} -> Bool
True
OverloadedLabel{} -> Bool
True
ParArray{} -> Bool
True
ParComp{} -> Bool
True
XTag{} -> Bool
True
IPVar{} -> Bool
True
UnboxedSum{} -> Bool
True
RecUpdate{} -> Bool
True
ParArrayFromTo{} -> Bool
True
ParArrayFromThenTo{} -> Bool
True
ParArrayComp{} -> Bool
True
VarQuote{} -> Bool
True
TypQuote{} -> Bool
True
BracketExp{} -> Bool
True
SpliceExp{} -> Bool
True
QuasiQuote{} -> Bool
True
TypeApp{} -> Bool
True
XETag{} -> Bool
True
XExpTag{} -> Bool
True
Lit _ x :: Literal l
x | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Literal l -> Bool
forall l. Literal l -> Bool
isNegative Literal l
x -> Bool
True
_ -> Bool
False
where
isNegative :: Literal l -> Bool
isNegative (Int _ x :: Integer
x _) = Integer
x Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< 0
isNegative (Frac _ x :: Rational
x _) = Rational
x Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
< 0
isNegative (PrimInt _ x :: Integer
x _) = Integer
x Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< 0
isNegative (PrimFloat _ x :: Rational
x _) = Rational
x Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
< 0
isNegative (PrimDouble _ x :: Rational
x _) = Rational
x Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
< 0
isNegative _ = Bool
False
needBracket :: Int -> Exp l -> Exp l -> Bool
needBracket i :: Int
i parent :: Exp l
parent child :: Exp l
child
| Exp l -> Bool
forall a. Brackets a => a -> Bool
isAtom Exp l
child = Bool
False
| InfixApp{} <- Exp l
parent, App{} <- Exp l
child = Bool
False
| Exp l -> Bool
forall l. Exp l -> Bool
isSection Exp l
parent, App{} <- Exp l
child = Bool
False
| Let{} <- Exp l
parent, App{} <- Exp l
child = Bool
False
| ListComp{} <- Exp l
parent = Bool
False
| List{} <- Exp l
parent = Bool
False
| Tuple{} <- Exp l
parent = Bool
False
| TupleSection{} <- Exp l
parent = Bool
False
| If{} <- Exp l
parent, Exp l -> Bool
forall l. Exp l -> Bool
isAnyApp Exp l
child = Bool
False
| App{} <- Exp l
parent, Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0, App{} <- Exp l
child = Bool
False
| ExpTypeSig{} <- Exp l
parent, Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0, Exp l -> Bool
forall l. Exp l -> Bool
isApp Exp l
child = Bool
False
| Paren{} <- Exp l
parent = Bool
False
| RecConstr{} <- Exp l
parent = Bool
False
| RecUpdate{} <- Exp l
parent, Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= 0 = Bool
False
| Case{} <- Exp l
parent, Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= 0 Bool -> Bool -> Bool
|| Exp l -> Bool
forall l. Exp l -> Bool
isAnyApp Exp l
child = Bool
False
| Lambda{} <- Exp l
parent = Bool
False
| Do{} <- Exp l
parent = Bool
False
| Bool
otherwise = Bool
True
instance Default l => Brackets (Type l) where
remParen :: Type l -> Maybe (Type l)
remParen (TyParen _ x :: Type l
x) = Type l -> Maybe (Type l)
forall a. a -> Maybe a
Just Type l
x
remParen _ = Maybe (Type l)
forall a. Maybe a
Nothing
addParen :: Type l -> Type l
addParen = l -> Type l -> Type l
forall l. l -> Type l -> Type l
TyParen l
forall a. Default a => a
def
isAtom :: Type l -> Bool
isAtom x :: Type l
x = case Type l
x of
TyParen{} -> Bool
True
TyTuple{} -> Bool
True
TyList{} -> Bool
True
TyVar{} -> Bool
True
TyCon{} -> Bool
True
TyPromoted{} -> Bool
True
TyUnboxedSum{} -> Bool
True
TyParArray{} -> Bool
True
TyKind{} -> Bool
True
TySplice{} -> Bool
True
TyWildCard{} -> Bool
True
TyQuasiQuote{} -> Bool
True
_ -> Bool
False
needBracket :: Int -> Type l -> Type l -> Bool
needBracket _ parent :: Type l
parent child :: Type l
child
| Type l -> Bool
forall a. Brackets a => a -> Bool
isAtom Type l
child = Bool
False
| TyFun{} <- Type l
parent, TyApp{} <- Type l
child = Bool
False
| TyTuple{} <- Type l
parent = Bool
False
| TyList{} <- Type l
parent = Bool
False
| TyInfix{} <- Type l
parent, TyApp{} <- Type l
child = Bool
False
| TyParen{} <- Type l
parent = Bool
False
| Bool
otherwise = Bool
True
instance Default l => Brackets (Pat l) where
remParen :: Pat l -> Maybe (Pat l)
remParen (PParen _ x :: Pat l
x) = Pat l -> Maybe (Pat l)
forall a. a -> Maybe a
Just Pat l
x
remParen _ = Maybe (Pat l)
forall a. Maybe a
Nothing
addParen :: Pat l -> Pat l
addParen = l -> Pat l -> Pat l
forall l. l -> Pat l -> Pat l
PParen l
forall a. Default a => a
def
isAtom :: Pat l -> Bool
isAtom x :: Pat l
x = case Pat l
x of
PParen{} -> Bool
True
PTuple{} -> Bool
True
PList{} -> Bool
True
PRec{} -> Bool
True
PVar{} -> Bool
True
PApp _ _ [] -> Bool
True
PWildCard{} -> Bool
True
PUnboxedSum{} -> Bool
True
PAsPat{} -> Bool
True
PIrrPat{} -> Bool
True
PXETag{} -> Bool
True
PXPatTag{} -> Bool
True
PSplice{} -> Bool
True
PQuasiQuote{} -> Bool
True
PLit _ Signless{} _ -> Bool
True
_ -> Bool
False
needBracket :: Int -> Pat l -> Pat l -> Bool
needBracket _ parent :: Pat l
parent child :: Pat l
child
| Pat l -> Bool
forall a. Brackets a => a -> Bool
isAtom Pat l
child = Bool
False
| PTuple{} <- Pat l
parent = Bool
False
| PList{} <- Pat l
parent = Bool
False
| PInfixApp{} <- Pat l
parent, PApp{} <- Pat l
child = Bool
False
| PParen{} <- Pat l
parent = Bool
False
| Bool
otherwise = Bool
True
paren :: (Data l, Default l) => Exp l -> Exp l
paren :: Exp l -> Exp l
paren x :: Exp l
x = if Exp l -> Bool
forall a. Brackets a => a -> Bool
isAtom Exp l
x then Exp l
x else Exp l -> Exp l
forall a. Brackets a => a -> a
addParen Exp l
x
descendBracket :: (Data l, Default l) => (Exp l -> (Bool, Exp l)) -> Exp l -> Exp l
descendBracket :: (Exp l -> (Bool, Exp l)) -> Exp l -> Exp l
descendBracket op :: Exp l -> (Bool, Exp l)
op x :: Exp l
x = (Int -> Exp l -> Exp l) -> Exp l -> Exp l
forall a. Data a => (Int -> a -> a) -> a -> a
descendIndex Int -> Exp l -> Exp l
g Exp l
x
where
g :: Int -> Exp l -> Exp l
g i :: Int
i y :: Exp l
y = if Bool
a then Int -> Exp l -> Exp l
f Int
i Exp l
b else Exp l
b
where (a :: Bool
a,b :: Exp l
b) = Exp l -> (Bool, Exp l)
op Exp l
y
f :: Int -> Exp l -> Exp l
f i :: Int
i (Paren _ y :: Exp l
y) | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Int -> Exp l -> Exp l -> Bool
forall a. Brackets a => Int -> a -> a -> Bool
needBracket Int
i Exp l
x Exp l
y = Exp l
y
f i :: Int
i y :: Exp l
y | Int -> Exp l -> Exp l -> Bool
forall a. Brackets a => Int -> a -> a -> Bool
needBracket Int
i Exp l
x Exp l
y = Exp l -> Exp l
forall a. Brackets a => a -> a
addParen Exp l
y
f _ y :: Exp l
y = Exp l
y
transformBracket :: (Data l, Default l) => (Exp l -> Maybe (Exp l)) -> Exp l -> Exp l
transformBracket :: (Exp l -> Maybe (Exp l)) -> Exp l -> Exp l
transformBracket op :: Exp l -> Maybe (Exp l)
op = (Bool, Exp l) -> Exp l
forall a b. (a, b) -> b
snd ((Bool, Exp l) -> Exp l)
-> (Exp l -> (Bool, Exp l)) -> Exp l -> Exp l
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Exp l -> (Bool, Exp l)
g
where
g :: Exp l -> (Bool, Exp l)
g = Exp l -> (Bool, Exp l)
f (Exp l -> (Bool, Exp l))
-> (Exp l -> Exp l) -> Exp l -> (Bool, Exp l)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Exp l -> (Bool, Exp l)) -> Exp l -> Exp l
forall l.
(Data l, Default l) =>
(Exp l -> (Bool, Exp l)) -> Exp l -> Exp l
descendBracket Exp l -> (Bool, Exp l)
g
f :: Exp l -> (Bool, Exp l)
f x :: Exp l
x = (Bool, Exp l)
-> (Exp l -> (Bool, Exp l)) -> Maybe (Exp l) -> (Bool, Exp l)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Bool
False,Exp l
x) ((,) Bool
True) (Exp l -> Maybe (Exp l)
op Exp l
x)
rebracket1 :: (Data l, Default l) => Exp l -> Exp l
rebracket1 :: Exp l -> Exp l
rebracket1 = (Exp l -> (Bool, Exp l)) -> Exp l -> Exp l
forall l.
(Data l, Default l) =>
(Exp l -> (Bool, Exp l)) -> Exp l -> Exp l
descendBracket (\x :: Exp l
x -> (Bool
True,Exp l
x))
appsBracket :: (Data l, Default l) => [Exp l] -> Exp l
appsBracket :: [Exp l] -> Exp l
appsBracket = (Exp l -> Exp l -> Exp l) -> [Exp l] -> Exp l
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 (\x :: Exp l
x -> Exp l -> Exp l
forall l. (Data l, Default l) => Exp l -> Exp l
rebracket1 (Exp l -> Exp l) -> (Exp l -> Exp l) -> Exp l -> Exp l
forall b c a. (b -> c) -> (a -> b) -> a -> c
. l -> Exp l -> Exp l -> Exp l
forall l. l -> Exp l -> Exp l -> Exp l
App l
forall a. Default a => a
def Exp l
x)
descendIndex :: Data a => (Int -> a -> a) -> a -> a
descendIndex :: (Int -> a -> a) -> a -> a
descendIndex f :: Int -> a -> a
f x :: a
x = (State Int a -> Int -> a) -> Int -> State Int a -> a
forall a b c. (a -> b -> c) -> b -> a -> c
flip State Int a -> Int -> a
forall s a. State s a -> s -> a
evalState 0 (State Int a -> a) -> State Int a -> a
forall a b. (a -> b) -> a -> b
$ ((a -> State Int a) -> a -> State Int a)
-> a -> (a -> State Int a) -> State Int a
forall a b c. (a -> b -> c) -> b -> a -> c
flip (a -> State Int a) -> a -> State Int a
forall on (m :: * -> *).
(Uniplate on, Monad m) =>
(on -> m on) -> on -> m on
descendM a
x ((a -> State Int a) -> State Int a)
-> (a -> State Int a) -> State Int a
forall a b. (a -> b) -> a -> b
$ \y :: a
y -> do
Int
i <- StateT Int Identity Int
forall (m :: * -> *) s. Monad m => StateT s m s
get
(Int -> Int) -> StateT Int Identity ()
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify (Int -> Int -> Int
forall a. Num a => a -> a -> a
+1)
a -> State Int a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> State Int a) -> a -> State Int a
forall a b. (a -> b) -> a -> b
$ Int -> a -> a
f Int
i a
y