{-# 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 l
_ Exp l
x) = forall a. a -> Maybe a
Just Exp l
x
remParen Exp l
_ = forall a. Maybe a
Nothing
addParen :: Exp l -> Exp l
addParen = forall l. l -> Exp l -> Exp l
Paren forall a. Default a => a
def
isAtom :: Exp l -> Bool
isAtom 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 l
_ Literal l
x | Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall {l}. Literal l -> Bool
isNegative Literal l
x -> Bool
True
Exp l
_ -> Bool
False
where
isNegative :: Literal l -> Bool
isNegative (Int l
_ Integer
x String
_) = Integer
x forall a. Ord a => a -> a -> Bool
< Integer
0
isNegative (Frac l
_ Rational
x String
_) = Rational
x forall a. Ord a => a -> a -> Bool
< Rational
0
isNegative (PrimInt l
_ Integer
x String
_) = Integer
x forall a. Ord a => a -> a -> Bool
< Integer
0
isNegative (PrimFloat l
_ Rational
x String
_) = Rational
x forall a. Ord a => a -> a -> Bool
< Rational
0
isNegative (PrimDouble l
_ Rational
x String
_) = Rational
x forall a. Ord a => a -> a -> Bool
< Rational
0
isNegative Literal l
_ = Bool
False
needBracket :: Int -> Exp l -> Exp l -> Bool
needBracket Int
i Exp l
parent Exp l
child
| forall a. Brackets a => a -> Bool
isAtom Exp l
child = Bool
False
| InfixApp{} <- Exp l
parent, App{} <- Exp l
child = Bool
False
| 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, forall l. Exp l -> Bool
isAnyApp Exp l
child = Bool
False
| App{} <- Exp l
parent, Int
i forall a. Eq a => a -> a -> Bool
== Int
0, App{} <- Exp l
child = Bool
False
| ExpTypeSig{} <- Exp l
parent, Int
i forall a. Eq a => a -> a -> Bool
== Int
0, 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 forall a. Eq a => a -> a -> Bool
/= Int
0 = Bool
False
| Case{} <- Exp l
parent, Int
i forall a. Eq a => a -> a -> Bool
/= Int
0 Bool -> Bool -> 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 l
_ Type l
x) = forall a. a -> Maybe a
Just Type l
x
remParen Type l
_ = forall a. Maybe a
Nothing
addParen :: Type l -> Type l
addParen = forall l. l -> Type l -> Type l
TyParen forall a. Default a => a
def
isAtom :: Type l -> Bool
isAtom 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
Type l
_ -> Bool
False
needBracket :: Int -> Type l -> Type l -> Bool
needBracket Int
_ Type l
parent Type l
child
| 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 l
_ Pat l
x) = forall a. a -> Maybe a
Just Pat l
x
remParen Pat l
_ = forall a. Maybe a
Nothing
addParen :: Pat l -> Pat l
addParen = forall l. l -> Pat l -> Pat l
PParen forall a. Default a => a
def
isAtom :: Pat l -> Bool
isAtom Pat l
x = case Pat l
x of
PParen{} -> Bool
True
PTuple{} -> Bool
True
PList{} -> Bool
True
PRec{} -> Bool
True
PVar{} -> Bool
True
PApp l
_ QName l
_ [] -> 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 l
_ Signless{} Literal l
_ -> Bool
True
Pat l
_ -> Bool
False
needBracket :: Int -> Pat l -> Pat l -> Bool
needBracket Int
_ Pat l
parent Pat l
child
| 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 :: forall l. (Data l, Default l) => Exp l -> Exp l
paren Exp l
x = if forall a. Brackets a => a -> Bool
isAtom Exp l
x then Exp l
x else 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 :: forall l.
(Data l, Default l) =>
(Exp l -> (Bool, Exp l)) -> Exp l -> Exp l
descendBracket Exp l -> (Bool, Exp l)
op Exp l
x = 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 Int
i Exp l
y = if Bool
a then Int -> Exp l -> Exp l
f Int
i Exp l
b else Exp l
b
where (Bool
a,Exp l
b) = Exp l -> (Bool, Exp l)
op Exp l
y
f :: Int -> Exp l -> Exp l
f Int
i (Paren l
_ Exp l
y) | Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall a. Brackets a => Int -> a -> a -> Bool
needBracket Int
i Exp l
x Exp l
y = Exp l
y
f Int
i Exp l
y | forall a. Brackets a => Int -> a -> a -> Bool
needBracket Int
i Exp l
x Exp l
y = forall a. Brackets a => a -> a
addParen Exp l
y
f Int
_ Exp l
y = Exp l
y
transformBracket :: (Data l, Default l) => (Exp l -> Maybe (Exp l)) -> Exp l -> Exp l
transformBracket :: forall l.
(Data l, Default l) =>
(Exp l -> Maybe (Exp l)) -> Exp l -> Exp l
transformBracket Exp l -> Maybe (Exp l)
op = forall a b. (a, b) -> b
snd 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 Exp l
x = 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 :: forall l. (Data l, Default l) => Exp l -> Exp l
rebracket1 = forall l.
(Data l, Default l) =>
(Exp l -> (Bool, Exp l)) -> Exp l -> Exp l
descendBracket (\Exp l
x -> (Bool
True,Exp l
x))
appsBracket :: (Data l, Default l) => [Exp l] -> Exp l
appsBracket :: forall l. (Data l, Default l) => [Exp l] -> Exp l
appsBracket = forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 (\Exp l
x -> forall l. (Data l, Default l) => Exp l -> Exp l
rebracket1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall l. l -> Exp l -> Exp l -> Exp l
App forall a. Default a => a
def Exp l
x)
descendIndex :: Data a => (Int -> a -> a) -> a -> a
descendIndex :: forall a. Data a => (Int -> a -> a) -> a -> a
descendIndex Int -> a -> a
f a
x = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall s a. State s a -> s -> a
evalState Int
0 forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> b -> a -> c
flip forall on (m :: * -> *).
(Uniplate on, Applicative m) =>
(on -> m on) -> on -> m on
descendM a
x forall a b. (a -> b) -> a -> b
$ \a
y -> do
Int
i <- forall (m :: * -> *) s. Monad m => StateT s m s
get
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify (forall a. Num a => a -> a -> a
+Int
1)
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Int -> a -> a
f Int
i a
y