{-# LANGUAGE CPP #-}
module GHC.SourceGen.Pat.Internal where

import GHC.Hs.Pat (Pat(..))
#if MIN_VERSION_ghc(9,0,0)
import GHC.Hs.Type (HsConDetails(..))
import GHC.Types.SrcLoc (unLoc)
#else
import GHC.Hs.Type (HsConDetails(..))
import SrcLoc (unLoc)
#endif

import GHC.SourceGen.Lit.Internal (litNeedsParen, overLitNeedsParen)
import GHC.SourceGen.Syntax.Internal

-- Note: GHC>=8.6 inserts parentheses automatically when pretty-printing patterns.
-- When we stop supporting lower versions, we may be able to simplify this.
parenthesize :: Pat' -> Pat'
parenthesize :: Pat' -> Pat'
parenthesize Pat'
p
    | Pat' -> Bool
needsPar Pat'
p = Pat' -> Pat'
parPat Pat'
p
    | Bool
otherwise = Pat'
p


needsPar :: Pat' -> Bool
#if MIN_VERSION_ghc(8,6,0)
needsPar :: Pat' -> Bool
needsPar (LitPat XLitPat GhcPs
_ HsLit GhcPs
l) = HsLit GhcPs -> Bool
litNeedsParen HsLit GhcPs
l
needsPar (NPat XNPat GhcPs
_ XRec GhcPs (HsOverLit GhcPs)
l Maybe (SyntaxExpr GhcPs)
_ SyntaxExpr GhcPs
_) = HsOverLit GhcPs -> Bool
overLitNeedsParen forall a b. (a -> b) -> a -> b
$ forall l e. GenLocated l e -> e
unLoc XRec GhcPs (HsOverLit GhcPs)
l
#else
needsPar (LitPat l) = litNeedsParen l
needsPar (NPat l _ _ _) = overLitNeedsParen $ unLoc l
#endif
#if MIN_VERSION_ghc(9,2,0)
needsPar (ConPat XConPat GhcPs
_ XRec GhcPs (ConLikeP GhcPs)
_ (PrefixCon [HsPatSigType (NoGhcTc GhcPs)]
_ [LPat GhcPs]
xs)) = Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Bool
null [LPat GhcPs]
xs
#elif MIN_VERSION_ghc(9,0,0)
needsPar (ConPat _ _ (PrefixCon xs)) = not $ null xs
#else
needsPar (ConPatIn _ (PrefixCon xs)) = not $ null xs
#endif
#if MIN_VERSION_ghc(9,0,0)
needsPar (ConPat XConPat GhcPs
_ XRec GhcPs (ConLikeP GhcPs)
_ (InfixCon LPat GhcPs
_ LPat GhcPs
_)) = Bool
True
#else
needsPar (ConPatIn _ (InfixCon _ _)) = True
needsPar ConPatOut{} = True
#endif
#if MIN_VERSION_ghc(8,6,0)
needsPar SigPat{} = Bool
True
#else
needsPar SigPatIn{} = True
needsPar SigPatOut{} = True
#endif
needsPar Pat'
_ = Bool
False

parPat :: Pat' -> Pat'
#if MIN_VERSION_ghc(9,4,0)
parPat p = withEpAnnNotUsed ParPat mkToken (builtPat p) mkToken
#else
parPat :: Pat' -> Pat'
parPat = forall ann a. (EpAnn ann -> a) -> a
withEpAnnNotUsed forall p. XParPat p -> LPat p -> Pat p
ParPat forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pat' -> LPat GhcPs
builtPat
#endif