{-# LANGUAGE MultiParamTypeClasses , FlexibleInstances, FlexibleContexts #-}
{-# OPTIONS_GHC -Wno-incomplete-patterns -Wno-overlapping-patterns #-}
module GHC.Util.Brackets (Brackets(..), isApp,isOpApp,isAnyApp) where
import GHC.Hs
import GHC.Types.SrcLoc
import GHC.Types.Basic
import Language.Haskell.GhclibParserEx.GHC.Hs.Expr
import Refact.Types
class Brackets a where
remParen :: a -> Maybe a
addParen :: a -> a
isAtom :: a -> Bool
needBracket :: Int -> a -> a -> Bool
findType :: a -> RType
instance Brackets (LHsExpr GhcPs) where
remParen :: LHsExpr GhcPs -> Maybe (LHsExpr GhcPs)
remParen (L SrcSpan
_ (HsPar XPar GhcPs
_ (L SrcSpan
_ SectionL{}))) = Maybe (LHsExpr GhcPs)
forall a. Maybe a
Nothing
remParen (L SrcSpan
_ (HsPar XPar GhcPs
_ (L SrcSpan
_ SectionR{}))) = Maybe (LHsExpr GhcPs)
forall a. Maybe a
Nothing
remParen (L SrcSpan
_ (HsPar XPar GhcPs
_ LHsExpr GhcPs
x)) = LHsExpr GhcPs -> Maybe (LHsExpr GhcPs)
forall a. a -> Maybe a
Just LHsExpr GhcPs
x
remParen LHsExpr GhcPs
_ = Maybe (LHsExpr GhcPs)
forall a. Maybe a
Nothing
addParen :: LHsExpr GhcPs -> LHsExpr GhcPs
addParen LHsExpr GhcPs
e = HsExpr GhcPs -> LHsExpr GhcPs
forall e. e -> Located e
noLoc (HsExpr GhcPs -> LHsExpr GhcPs) -> HsExpr 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 NoExtField
XPar GhcPs
noExtField LHsExpr GhcPs
e
isAtom :: LHsExpr GhcPs -> Bool
isAtom (L SrcSpan
_ HsExpr GhcPs
x) = case HsExpr GhcPs
x of
HsVar{} -> Bool
True
HsUnboundVar{} -> Bool
True
HsRecFld{} -> Bool
False
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 XOverLitE GhcPs
_ HsOverLit GhcPs
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 XLitE GhcPs
_ HsLit GhcPs
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
HsExpr GhcPs
_ -> Bool
False
where
isNegativeLit :: HsLit x -> Bool
isNegativeLit (HsInt XHsInt x
_ IntegralLit
i) = IntegralLit -> Bool
il_neg IntegralLit
i
isNegativeLit (HsRat XHsRat x
_ FractionalLit
f Type
_) = FractionalLit -> Bool
fl_neg FractionalLit
f
isNegativeLit (HsFloatPrim XHsFloatPrim x
_ FractionalLit
f) = FractionalLit -> Bool
fl_neg FractionalLit
f
isNegativeLit (HsDoublePrim XHsDoublePrim x
_ FractionalLit
f) = FractionalLit -> Bool
fl_neg FractionalLit
f
isNegativeLit (HsIntPrim XHsIntPrim x
_ Integer
x) = Integer
x Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0
isNegativeLit (HsInt64Prim XHsInt64Prim x
_ Integer
x) = Integer
x Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0
isNegativeLit (HsInteger XHsInteger x
_ Integer
x Type
_) = Integer
x Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0
isNegativeLit HsLit x
_ = Bool
False
isNegativeOverLit :: HsOverLit p -> Bool
isNegativeOverLit OverLit {ol_val :: forall p. HsOverLit p -> OverLitVal
ol_val=HsIntegral IntegralLit
i} = IntegralLit -> Bool
il_neg IntegralLit
i
isNegativeOverLit OverLit {ol_val :: forall p. HsOverLit p -> OverLitVal
ol_val=HsFractional FractionalLit
f} = FractionalLit -> Bool
fl_neg FractionalLit
f
isNegativeOverLit HsOverLit p
_ = Bool
False
isAtom LHsExpr GhcPs
_ = Bool
False
needBracket :: Int -> LHsExpr GhcPs -> LHsExpr GhcPs -> Bool
needBracket Int
i LHsExpr GhcPs
parent 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, L SrcSpan
_ HsApp{} <- LHsExpr GhcPs
child = Bool
False
| L SrcSpan
_ OpApp{} <- LHsExpr GhcPs
parent, L SrcSpan
_ HsApp{} <- LHsExpr GhcPs
child, Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0 Bool -> Bool -> Bool
|| LHsExpr GhcPs -> Bool
isAtomOrApp LHsExpr GhcPs
child = Bool
False
| L SrcSpan
_ ExplicitList{} <- LHsExpr GhcPs
parent = Bool
False
| L SrcSpan
_ ExplicitTuple{} <- LHsExpr GhcPs
parent = Bool
False
| L SrcSpan
_ HsIf{} <- LHsExpr GhcPs
parent, LHsExpr GhcPs -> Bool
isAnyApp LHsExpr GhcPs
child = Bool
False
| L SrcSpan
_ HsApp{} <- LHsExpr GhcPs
parent, Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0, L SrcSpan
_ HsApp{} <- LHsExpr GhcPs
child = Bool
False
| L SrcSpan
_ ExprWithTySig{} <- LHsExpr GhcPs
parent, Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0, LHsExpr GhcPs -> Bool
isApp LHsExpr GhcPs
child = Bool
False
| L SrcSpan
_ RecordCon{} <- LHsExpr GhcPs
parent = Bool
False
| L SrcSpan
_ RecordUpd{} <- LHsExpr GhcPs
parent, Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0 = Bool
False
| L SrcSpan
_ HsLet{} <- LHsExpr GhcPs
parent, LHsExpr GhcPs -> Bool
isApp LHsExpr GhcPs
child = Bool
False
| L SrcSpan
_ HsDo{} <- LHsExpr GhcPs
parent, LHsExpr GhcPs -> Bool
isAnyApp LHsExpr GhcPs
child = Bool
False
| L SrcSpan
_ HsLam{} <- LHsExpr GhcPs
parent, LHsExpr GhcPs -> Bool
isAnyApp LHsExpr GhcPs
child = Bool
False
| L SrcSpan
_ HsCase{} <- LHsExpr GhcPs
parent, LHsExpr GhcPs -> Bool
isAnyApp LHsExpr GhcPs
child = Bool
False
| L SrcSpan
_ HsPar{} <- LHsExpr GhcPs
parent = Bool
False
| Bool
otherwise = Bool
True
findType :: LHsExpr GhcPs -> RType
findType LHsExpr GhcPs
_ = RType
Expr
isAtomOrApp :: LHsExpr GhcPs -> Bool
isAtomOrApp :: LHsExpr GhcPs -> Bool
isAtomOrApp LHsExpr GhcPs
x | LHsExpr GhcPs -> Bool
forall a. Brackets a => a -> Bool
isAtom LHsExpr GhcPs
x = Bool
True
isAtomOrApp (L SrcSpan
_ (HsApp XApp GhcPs
_ LHsExpr GhcPs
_ LHsExpr GhcPs
x)) = LHsExpr GhcPs -> Bool
isAtomOrApp LHsExpr GhcPs
x
isAtomOrApp LHsExpr GhcPs
_ = Bool
False
instance Brackets (Located (Pat GhcPs)) where
remParen :: Located (Pat GhcPs) -> Maybe (Located (Pat GhcPs))
remParen (L SrcSpan
_ (ParPat XParPat GhcPs
_ LPat GhcPs
x)) = Located (Pat GhcPs) -> Maybe (Located (Pat GhcPs))
forall a. a -> Maybe a
Just LPat GhcPs
Located (Pat GhcPs)
x
remParen Located (Pat GhcPs)
_ = Maybe (Located (Pat GhcPs))
forall a. Maybe a
Nothing
addParen :: Located (Pat GhcPs) -> Located (Pat GhcPs)
addParen Located (Pat GhcPs)
e = Pat GhcPs -> Located (Pat GhcPs)
forall e. e -> Located e
noLoc (Pat GhcPs -> Located (Pat GhcPs))
-> Pat GhcPs -> Located (Pat GhcPs)
forall a b. (a -> b) -> a -> b
$ XParPat GhcPs -> LPat GhcPs -> Pat GhcPs
forall p. XParPat p -> LPat p -> Pat p
ParPat NoExtField
XParPat GhcPs
noExtField LPat GhcPs
Located (Pat GhcPs)
e
isAtom :: Located (Pat GhcPs) -> Bool
isAtom (L SrcSpan
_ Pat GhcPs
x) = case Pat GhcPs
x of
ParPat{} -> Bool
True
TuplePat{} -> Bool
True
ListPat{} -> Bool
True
ConPat XConPat GhcPs
_ Located (ConLikeP GhcPs)
_ RecCon{} -> Bool
False
ConPat XConPat GhcPs
_ Located (ConLikeP GhcPs)
_ (PrefixCon []) -> Bool
True
VarPat{} -> Bool
True
WildPat{} -> Bool
True
SumPat{} -> Bool
True
AsPat{} -> Bool
True
SplicePat{} -> Bool
True
LitPat XLitPat GhcPs
_ HsLit GhcPs
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
Pat GhcPs
_ -> 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 HsLit x
_ = Bool
False
isAtom Located (Pat GhcPs)
_ = Bool
False
needBracket :: Int -> Located (Pat GhcPs) -> Located (Pat GhcPs) -> Bool
needBracket Int
_ Located (Pat GhcPs)
parent Located (Pat GhcPs)
child
| Located (Pat GhcPs) -> Bool
forall a. Brackets a => a -> Bool
isAtom Located (Pat GhcPs)
child = Bool
False
| L SrcSpan
_ TuplePat{} <- Located (Pat GhcPs)
parent = Bool
False
| L SrcSpan
_ ListPat{} <- Located (Pat GhcPs)
parent = Bool
False
| Bool
otherwise = Bool
True
findType :: Located (Pat GhcPs) -> RType
findType Located (Pat GhcPs)
_ = RType
Pattern
instance Brackets (LHsType GhcPs) where
remParen :: LHsType GhcPs -> Maybe (LHsType GhcPs)
remParen (L SrcSpan
_ (HsParTy XParTy GhcPs
_ LHsType GhcPs
x)) = LHsType GhcPs -> Maybe (LHsType GhcPs)
forall a. a -> Maybe a
Just LHsType GhcPs
x
remParen LHsType GhcPs
_ = Maybe (LHsType GhcPs)
forall a. Maybe a
Nothing
addParen :: LHsType GhcPs -> LHsType GhcPs
addParen LHsType GhcPs
e = HsType GhcPs -> LHsType GhcPs
forall e. e -> Located e
noLoc (HsType GhcPs -> LHsType GhcPs) -> HsType 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 NoExtField
XParTy GhcPs
noExtField LHsType GhcPs
e
isAtom :: LHsType GhcPs -> Bool
isAtom (L SrcSpan
_ HsType GhcPs
x) = case HsType GhcPs
x of
HsParTy{} -> Bool
True
HsTupleTy{} -> Bool
True
HsListTy{} -> Bool
True
HsExplicitTupleTy{} -> Bool
True
HsExplicitListTy{} -> Bool
True
HsTyVar{} -> Bool
True
HsSumTy{} -> Bool
True
HsWildCardTy{} -> Bool
True
HsType GhcPs
_ -> Bool
False
isAtom LHsType GhcPs
_ = Bool
False
needBracket :: Int -> LHsType GhcPs -> LHsType GhcPs -> Bool
needBracket Int
_ LHsType GhcPs
parent LHsType GhcPs
child
| LHsType GhcPs -> Bool
forall a. Brackets a => a -> Bool
isAtom LHsType GhcPs
child = Bool
False
| L SrcSpan
_ HsFunTy{} <- LHsType GhcPs
parent, L SrcSpan
_ HsAppTy{} <- LHsType GhcPs
child = Bool
False
| L SrcSpan
_ HsTupleTy{} <- LHsType GhcPs
parent = Bool
False
| L SrcSpan
_ HsListTy{} <- LHsType GhcPs
parent = Bool
False
| L SrcSpan
_ HsExplicitTupleTy{} <- LHsType GhcPs
parent = Bool
False
| L SrcSpan
_ HsListTy{} <- LHsType GhcPs
parent = Bool
False
| L SrcSpan
_ HsExplicitListTy{} <- LHsType GhcPs
parent = Bool
False
| L SrcSpan
_ HsOpTy{} <- LHsType GhcPs
parent, L SrcSpan
_ HsAppTy{} <- LHsType GhcPs
child = Bool
False
| L SrcSpan
_ HsParTy{} <- LHsType GhcPs
parent = Bool
False
| Bool
otherwise = Bool
True
findType :: LHsType GhcPs -> RType
findType LHsType GhcPs
_ = RType
Type