{-# LANGUAGE MultiParamTypeClasses , FlexibleInstances, FlexibleContexts #-}
module GHC.Util.Brackets (Brackets'(..), isApp,isOpApp,isAnyApp) where
import HsSyn
import SrcLoc
import BasicTypes
import Language.Haskell.GhclibParserEx.GHC.Hs.Expr
class Brackets' a where
remParen' :: a -> Maybe a
addParen' :: a -> a
isAtom' :: a -> Bool
needBracket' :: Int -> a -> a -> Bool
instance Brackets' (LHsExpr GhcPs) where
remParen' :: LHsExpr GhcPs -> Maybe (LHsExpr GhcPs)
remParen' (LL _ (HsPar _ (LL _ SectionL{}))) = Maybe (LHsExpr GhcPs)
forall a. Maybe a
Nothing
remParen' (LL _ (HsPar _ (LL _ SectionR{}))) = Maybe (LHsExpr GhcPs)
forall a. Maybe a
Nothing
remParen' (LL _ (HsPar _ x)) = LHsExpr GhcPs -> Maybe (LHsExpr GhcPs)
forall a. a -> Maybe a
Just LHsExpr GhcPs
x
remParen' _ = Maybe (LHsExpr GhcPs)
forall a. Maybe a
Nothing
addParen' :: LHsExpr GhcPs -> LHsExpr GhcPs
addParen' e :: LHsExpr GhcPs
e = SrcSpanLess (LHsExpr GhcPs) -> LHsExpr GhcPs
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc (SrcSpanLess (LHsExpr GhcPs) -> LHsExpr GhcPs)
-> SrcSpanLess (LHsExpr GhcPs) -> LHsExpr GhcPs
forall a b. (a -> b) -> a -> b
$ XPar GhcPs -> LHsExpr GhcPs -> HsExpr GhcPs
forall p. XPar p -> LHsExpr p -> HsExpr p
HsPar NoExt
XPar GhcPs
noExt LHsExpr GhcPs
e
isAtom' :: LHsExpr GhcPs -> Bool
isAtom' (LL _ x :: SrcSpanLess (LHsExpr GhcPs)
x) = case SrcSpanLess (LHsExpr GhcPs)
x of
HsVar{} -> Bool
True
HsUnboundVar{} -> Bool
True
HsRecFld{} -> Bool
True
HsOverLabel{} -> Bool
True
HsIPVar{} -> Bool
True
HsPar{} -> Bool
True
ExplicitTuple{} -> Bool
True
ExplicitSum{} -> Bool
True
ExplicitList{} -> Bool
True
RecordCon{} -> Bool
True
RecordUpd{} -> Bool
True
ArithSeq{}-> Bool
True
HsBracket{} -> Bool
True
HsSpliceE {} -> Bool
True
HsOverLit _ x | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ HsOverLit GhcPs -> Bool
forall p. HsOverLit p -> Bool
isNegativeOverLit HsOverLit GhcPs
x -> Bool
True
HsLit _ x | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ HsLit GhcPs -> Bool
forall x. HsLit x -> Bool
isNegativeLit HsLit GhcPs
x -> Bool
True
_ -> Bool
False
where
isNegativeLit :: HsLit x -> Bool
isNegativeLit (HsInt _ i :: IntegralLit
i) = IntegralLit -> Bool
il_neg IntegralLit
i
isNegativeLit (HsRat _ f :: FractionalLit
f _) = FractionalLit -> Bool
fl_neg FractionalLit
f
isNegativeLit (HsFloatPrim _ f :: FractionalLit
f) = FractionalLit -> Bool
fl_neg FractionalLit
f
isNegativeLit (HsDoublePrim _ f :: FractionalLit
f) = FractionalLit -> Bool
fl_neg FractionalLit
f
isNegativeLit (HsIntPrim _ x :: Integer
x) = Integer
x Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< 0
isNegativeLit (HsInt64Prim _ x :: Integer
x) = Integer
x Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< 0
isNegativeLit (HsInteger _ x :: Integer
x _) = Integer
x Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< 0
isNegativeLit _ = Bool
False
isNegativeOverLit :: HsOverLit p -> Bool
isNegativeOverLit OverLit {ol_val :: forall p. HsOverLit p -> OverLitVal
ol_val=HsIntegral i :: IntegralLit
i} = IntegralLit -> Bool
il_neg IntegralLit
i
isNegativeOverLit OverLit {ol_val :: forall p. HsOverLit p -> OverLitVal
ol_val=HsFractional f :: FractionalLit
f} = FractionalLit -> Bool
fl_neg FractionalLit
f
isNegativeOverLit _ = Bool
False
isAtom' _ = Bool
False
needBracket' :: Int -> LHsExpr GhcPs -> LHsExpr GhcPs -> Bool
needBracket' i :: Int
i parent :: LHsExpr GhcPs
parent child :: LHsExpr GhcPs
child
| LHsExpr GhcPs -> Bool
forall a. Brackets' a => a -> Bool
isAtom' LHsExpr GhcPs
child = Bool
False
| LHsExpr GhcPs -> Bool
isSection LHsExpr GhcPs
parent, LL _ HsApp{} <- LHsExpr GhcPs
child = Bool
False
| LL _ OpApp{} <- LHsExpr GhcPs
parent, LL _ HsApp{} <- LHsExpr GhcPs
child = Bool
False
| LL _ HsLet{} <- LHsExpr GhcPs
parent, LL _ HsApp{} <- LHsExpr GhcPs
child = Bool
False
| LL _ HsDo{} <- LHsExpr GhcPs
parent = Bool
False
| LL _ ExplicitList{} <- LHsExpr GhcPs
parent = Bool
False
| LL _ ExplicitTuple{} <- LHsExpr GhcPs
parent = Bool
False
| LL _ HsIf{} <- LHsExpr GhcPs
parent, LHsExpr GhcPs -> Bool
isAnyApp LHsExpr GhcPs
child = Bool
False
| LL _ HsApp{} <- LHsExpr GhcPs
parent, Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0, LL _ HsApp{} <- LHsExpr GhcPs
child = Bool
False
| LL _ ExprWithTySig{} <- LHsExpr GhcPs
parent, Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0, LHsExpr GhcPs -> Bool
isApp LHsExpr GhcPs
child = Bool
False
| LL _ RecordCon{} <- LHsExpr GhcPs
parent = Bool
False
| LL _ RecordUpd{} <- LHsExpr GhcPs
parent, Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= 0 = Bool
False
| LL _ HsCase{} <- LHsExpr GhcPs
parent, Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= 0 Bool -> Bool -> Bool
|| LHsExpr GhcPs -> Bool
isAnyApp LHsExpr GhcPs
child = Bool
False
| LL _ HsLam{} <- LHsExpr GhcPs
parent = Bool
False
| LL _ HsPar{} <- LHsExpr GhcPs
parent = Bool
False
| LL _ HsDo {} <- LHsExpr GhcPs
parent = Bool
False
| Bool
otherwise = Bool
True
instance Brackets' (Pat GhcPs) where
remParen' :: Pat GhcPs -> Maybe (Pat GhcPs)
remParen' (LL _ (ParPat _ x)) = Pat GhcPs -> Maybe (Pat GhcPs)
forall a. a -> Maybe a
Just Pat GhcPs
x
remParen' _ = Maybe (Pat GhcPs)
forall a. Maybe a
Nothing
addParen' :: Pat GhcPs -> Pat GhcPs
addParen' e :: Pat GhcPs
e = SrcSpanLess (Pat GhcPs) -> Pat GhcPs
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc (SrcSpanLess (Pat GhcPs) -> Pat GhcPs)
-> SrcSpanLess (Pat GhcPs) -> Pat GhcPs
forall a b. (a -> b) -> a -> b
$ XParPat GhcPs -> Pat GhcPs -> Pat GhcPs
forall p. XParPat p -> LPat p -> LPat p
ParPat NoExt
XParPat GhcPs
noExt Pat GhcPs
e
isAtom' :: Pat GhcPs -> Bool
isAtom' (LL _ x :: SrcSpanLess (Pat GhcPs)
x) = case SrcSpanLess (Pat GhcPs)
x of
ParPat{} -> Bool
True
TuplePat{} -> Bool
True
ListPat{} -> Bool
True
ConPatIn _ RecCon{} -> Bool
True
ConPatIn _ (PrefixCon []) -> Bool
True
VarPat{} -> Bool
True
WildPat{} -> Bool
True
SumPat{} -> Bool
True
AsPat{} -> Bool
True
SplicePat{} -> Bool
True
LitPat _ x | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ HsLit GhcPs -> Bool
forall x. HsLit x -> Bool
isSignedLit HsLit GhcPs
x -> Bool
True
_ -> Bool
False
where
isSignedLit :: HsLit x -> Bool
isSignedLit HsInt{} = Bool
True
isSignedLit HsIntPrim{} = Bool
True
isSignedLit HsInt64Prim{} = Bool
True
isSignedLit HsInteger{} = Bool
True
isSignedLit HsRat{} = Bool
True
isSignedLit HsFloatPrim{} = Bool
True
isSignedLit HsDoublePrim{} = Bool
True
isSignedLit _ = Bool
False
isAtom' _ = Bool
False
needBracket' :: Int -> Pat GhcPs -> Pat GhcPs -> Bool
needBracket' _ parent :: Pat GhcPs
parent child :: Pat GhcPs
child
| Pat GhcPs -> Bool
forall a. Brackets' a => a -> Bool
isAtom' Pat GhcPs
child = Bool
False
| LL _ TuplePat{} <- Pat GhcPs
parent = Bool
False
| LL _ ListPat{} <- Pat GhcPs
parent = Bool
False
| Bool
otherwise = Bool
True
instance Brackets' (LHsType GhcPs) where
remParen' :: LHsType GhcPs -> Maybe (LHsType GhcPs)
remParen' (LL _ (HsParTy _ x)) = LHsType GhcPs -> Maybe (LHsType GhcPs)
forall a. a -> Maybe a
Just LHsType GhcPs
x
remParen' _ = Maybe (LHsType GhcPs)
forall a. Maybe a
Nothing
addParen' :: LHsType GhcPs -> LHsType GhcPs
addParen' e :: LHsType GhcPs
e = SrcSpanLess (LHsType GhcPs) -> LHsType GhcPs
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc (SrcSpanLess (LHsType GhcPs) -> LHsType GhcPs)
-> SrcSpanLess (LHsType GhcPs) -> LHsType GhcPs
forall a b. (a -> b) -> a -> b
$ XParTy GhcPs -> LHsType GhcPs -> HsType GhcPs
forall pass. XParTy pass -> LHsType pass -> HsType pass
HsParTy NoExt
XParTy GhcPs
noExt LHsType GhcPs
e
isAtom' :: LHsType GhcPs -> Bool
isAtom' (LL _ x :: SrcSpanLess (LHsType GhcPs)
x) = case SrcSpanLess (LHsType GhcPs)
x of
HsParTy{} -> Bool
True
HsTupleTy{} -> Bool
True
HsListTy{} -> Bool
True
HsExplicitTupleTy{} -> Bool
True
HsExplicitListTy{} -> Bool
True
HsTyVar{} -> Bool
True
HsSumTy{} -> Bool
True
HsSpliceTy{} -> Bool
True
HsWildCardTy{} -> Bool
True
_ -> Bool
False
isAtom' _ = Bool
False
needBracket' :: Int -> LHsType GhcPs -> LHsType GhcPs -> Bool
needBracket' _ parent :: LHsType GhcPs
parent child :: LHsType GhcPs
child
| LHsType GhcPs -> Bool
forall a. Brackets' a => a -> Bool
isAtom' LHsType GhcPs
child = Bool
False
| LL _ HsFunTy{} <- LHsType GhcPs
parent, LL _ HsAppTy{} <- LHsType GhcPs
child = Bool
False
| LL _ HsTupleTy{} <- LHsType GhcPs
parent = Bool
False
| LL _ HsListTy{} <- LHsType GhcPs
parent = Bool
False
| LL _ HsExplicitTupleTy{} <- LHsType GhcPs
parent = Bool
False
| LL _ HsListTy{} <- LHsType GhcPs
parent = Bool
False
| LL _ HsExplicitListTy{} <- LHsType GhcPs
parent = Bool
False
| LL _ HsOpTy{} <- LHsType GhcPs
parent, LL _ HsAppTy{} <- LHsType GhcPs
child = Bool
False
| LL _ HsParTy{} <- LHsType GhcPs
parent = Bool
False
| Bool
otherwise = Bool
True