-- Copyright 2019 Google LLC
--
-- Use of this source code is governed by a BSD-style
-- license that can be found in the LICENSE file or at
-- https://developers.google.com/open-source/licenses/bsd

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

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

import GHC.SourceGen.Lit.Internal
import GHC.SourceGen.Syntax.Internal

parenthesizeExprForApp, parenthesizeExprForOp
    :: LHsExpr' -> LHsExpr'
parenthesizeExprForApp :: LHsExpr' -> LHsExpr'
parenthesizeExprForApp LHsExpr'
e 
    | HsExpr' -> Bool
needsExprForApp (LHsExpr' -> SrcSpanLess LHsExpr'
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc LHsExpr'
e) = LHsExpr' -> LHsExpr'
parExpr LHsExpr'
e
    | Bool
otherwise = LHsExpr'
e
parenthesizeExprForOp :: LHsExpr' -> LHsExpr'
parenthesizeExprForOp LHsExpr'
e
    | HsExpr' -> Bool
needsExprForOp (LHsExpr' -> SrcSpanLess LHsExpr'
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc LHsExpr'
e) = LHsExpr' -> LHsExpr'
parExpr LHsExpr'
e
    | Bool
otherwise = LHsExpr'
e

parExpr :: LHsExpr' -> LHsExpr'
parExpr :: LHsExpr' -> LHsExpr'
parExpr = HsExpr' -> LHsExpr'
forall a ann. a -> GenLocated (SrcSpanAnn ann) a
mkLocated (HsExpr' -> LHsExpr')
-> (LHsExpr' -> HsExpr') -> LHsExpr' -> LHsExpr'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NoExtField -> LHsExpr' -> HsExpr') -> LHsExpr' -> HsExpr'
forall a. (NoExtField -> a) -> a
withEpAnnNotUsed NoExtField -> LHsExpr' -> HsExpr'
forall p. XPar p -> LHsExpr p -> HsExpr p
HsPar

#if MIN_VERSION_ghc(8,6,0)
#define WILD_EXT _
#else
#define WILD_EXT
#endif

needsExprForApp, needsExprForOp :: HsExpr' -> Bool
needsExprForOp :: HsExpr' -> Bool
needsExprForOp HsExpr'
e = case HsExpr'
e of
    -- TODO: more care for literals; only needed for negative numbers?
    HsLit WILD_EXT l -> litNeedsParen l
    HsOverLit WILD_EXT l -> overLitNeedsParen l
    HsLam{} -> Bool
True
    HsLamCase{} -> Bool
True
    OpApp{} -> Bool
True
    NegApp{} -> Bool
True
    HsCase{} -> Bool
True
    HsIf{} -> Bool
True
    HsMultiIf{} -> Bool
True
    HsLet{} -> Bool
True
    HsDo{} -> Bool
True
    ExprWithTySig{} -> Bool
True
    HsExpr'
_ -> Bool
False
needsExprForApp :: HsExpr' -> Bool
needsExprForApp HsExpr'
e = case HsExpr'
e of
    HsApp{} -> Bool
True
    HsAppType{} -> Bool
True
    HsStatic{} -> Bool
True
    HsExpr'
_ -> HsExpr' -> Bool
needsExprForOp HsExpr'
e