-- 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.Type.Internal where

import GHC.Hs (GhcPs)

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

import GHC.SourceGen.Syntax.Internal

mkQTyVars :: [HsTyVarBndr'] -> LHsQTyVars'
mkQTyVars :: [HsTyVarBndr'] -> LHsQTyVars'
mkQTyVars [HsTyVarBndr']
vars =  LHsQTyVars' -> LHsQTyVars'
forall a. a -> a
withPlaceHolder
                (LHsQTyVars' -> LHsQTyVars') -> LHsQTyVars' -> LHsQTyVars'
forall a b. (a -> b) -> a -> b
$ (NoExtField
 -> [GenLocated (SrcSpanAnn Any) HsTyVarBndr'] -> LHsQTyVars')
-> [GenLocated (SrcSpanAnn Any) HsTyVarBndr'] -> LHsQTyVars'
forall a. (NoExtField -> a) -> a
noExt ((NoExtField
 -> [GenLocated (SrcSpanAnn Any) HsTyVarBndr'] -> LHsQTyVars')
-> NoExtField
-> [GenLocated (SrcSpanAnn Any) HsTyVarBndr']
-> LHsQTyVars'
forall a. a -> a
withPlaceHolder NoExtField
-> [GenLocated (SrcSpanAnn Any) HsTyVarBndr'] -> LHsQTyVars'
forall pass. XHsQTvs pass -> [LHsTyVarBndr pass] -> LHsQTyVars pass
HsQTvs)
                ([GenLocated (SrcSpanAnn Any) HsTyVarBndr'] -> LHsQTyVars')
-> [GenLocated (SrcSpanAnn Any) HsTyVarBndr'] -> LHsQTyVars'
forall a b. (a -> b) -> a -> b
$ (HsTyVarBndr' -> GenLocated (SrcSpanAnn Any) HsTyVarBndr')
-> [HsTyVarBndr'] -> [GenLocated (SrcSpanAnn Any) HsTyVarBndr']
forall a b. (a -> b) -> [a] -> [b]
map HsTyVarBndr' -> GenLocated (SrcSpanAnn Any) HsTyVarBndr'
forall a ann. a -> GenLocated (SrcSpanAnn Any) a
mkLocated [HsTyVarBndr']
vars

sigType :: HsType' -> LHsSigType'
#if MIN_VERSION_ghc(9,2,0)
sigType = mkLocated . noExt HsSig (noExt HsOuterImplicit) . mkLocated
#else
sigType :: HsType' -> LHsSigType'
sigType = LHsSigType' -> LHsSigType'
forall a. a -> a
withPlaceHolder (LHsSigType' -> LHsSigType')
-> (HsType' -> LHsSigType') -> HsType' -> LHsSigType'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NoExtField -> Located HsType' -> LHsSigType')
-> Located HsType' -> LHsSigType'
forall a. (NoExtField -> a) -> a
noExt ((NoExtField -> Located HsType' -> LHsSigType')
-> NoExtField -> Located HsType' -> LHsSigType'
forall a. a -> a
withPlaceHolder NoExtField -> Located HsType' -> LHsSigType'
forall pass thing.
XHsIB pass thing -> thing -> HsImplicitBndrs pass thing
Types.HsIB) (Located HsType' -> LHsSigType')
-> (HsType' -> Located HsType') -> HsType' -> LHsSigType'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsType' -> Located HsType'
forall e. e -> Located e
builtLoc
#endif


-- TODO: GHC >= 8.6 provides parenthesizeHsType.  For consistency with
-- older versions, we're implementing our own parenthesis-wrapping.
-- Once we stop supporting GHC-8.4, we can switch to that implementation.

parenthesizeTypeForApp, parenthesizeTypeForOp, parenthesizeTypeForFun
    :: LHsType GhcPs -> LHsType GhcPs
parenthesizeTypeForApp :: Located HsType' -> Located HsType'
parenthesizeTypeForApp Located HsType'
t
    | HsType' -> Bool
needsParenForApp (Located HsType' -> SrcSpanLess (Located HsType')
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc Located HsType'
t) = Located HsType' -> Located HsType'
parTy Located HsType'
t
    | Bool
otherwise = Located HsType'
t
parenthesizeTypeForOp :: Located HsType' -> Located HsType'
parenthesizeTypeForOp Located HsType'
t
    | HsType' -> Bool
needsParenForOp (Located HsType' -> SrcSpanLess (Located HsType')
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc Located HsType'
t) = Located HsType' -> Located HsType'
parTy Located HsType'
t
    | Bool
otherwise = Located HsType'
t
parenthesizeTypeForFun :: Located HsType' -> Located HsType'
parenthesizeTypeForFun Located HsType'
t
    | HsType' -> Bool
needsParenForFun (Located HsType' -> SrcSpanLess (Located HsType')
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc Located HsType'
t) = Located HsType' -> Located HsType'
parTy Located HsType'
t
    | Bool
otherwise = Located HsType'
t

needsParenForFun, needsParenForOp, needsParenForApp
    :: HsType' -> Bool
needsParenForFun :: HsType' -> Bool
needsParenForFun HsType'
t = case HsType'
t of
    HsForAllTy{} -> Bool
True
    HsQualTy{} -> Bool
True
    HsFunTy{} -> Bool
True
    HsType'
_ -> Bool
False
needsParenForOp :: HsType' -> Bool
needsParenForOp HsType'
t = case HsType'
t of
    HsOpTy{} -> Bool
True
    HsType'
_ -> HsType' -> Bool
needsParenForFun HsType'
t
needsParenForApp :: HsType' -> Bool
needsParenForApp HsType'
t = case HsType'
t of
    HsAppTy {} -> Bool
True
    HsType'
_ -> HsType' -> Bool
needsParenForOp HsType'
t

parTy :: LHsType GhcPs -> LHsType GhcPs
parTy :: Located HsType' -> Located HsType'
parTy = HsType' -> Located HsType'
forall a ann. a -> GenLocated (SrcSpanAnn Any) a
mkLocated (HsType' -> Located HsType')
-> (Located HsType' -> HsType')
-> Located HsType'
-> Located HsType'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NoExtField -> Located HsType' -> HsType')
-> Located HsType' -> HsType'
forall a. (NoExtField -> a) -> a
withEpAnnNotUsed NoExtField -> Located HsType' -> HsType'
forall pass. XParTy pass -> LHsType pass -> HsType pass
HsParTy

sigWcType :: HsType' -> LHsSigWcType'
sigWcType :: HsType' -> LHsSigWcType'
sigWcType = (NoExtField -> LHsSigType' -> LHsSigWcType')
-> LHsSigType' -> LHsSigWcType'
forall a. (NoExtField -> a) -> a
noExt ((NoExtField -> LHsSigType' -> LHsSigWcType')
-> NoExtField -> LHsSigType' -> LHsSigWcType'
forall a. a -> a
withPlaceHolder NoExtField -> LHsSigType' -> LHsSigWcType'
forall pass thing.
XHsWC pass thing -> thing -> HsWildCardBndrs pass thing
Types.HsWC) (LHsSigType' -> LHsSigWcType')
-> (HsType' -> LHsSigType') -> HsType' -> LHsSigWcType'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsType' -> LHsSigType'
sigType

wcType :: HsType' -> LHsWcType'
wcType :: HsType' -> LHsWcType'
wcType = (NoExtField -> Located HsType' -> LHsWcType')
-> Located HsType' -> LHsWcType'
forall a. (NoExtField -> a) -> a
noExt ((NoExtField -> Located HsType' -> LHsWcType')
-> NoExtField -> Located HsType' -> LHsWcType'
forall a. a -> a
withPlaceHolder NoExtField -> Located HsType' -> LHsWcType'
forall pass thing.
XHsWC pass thing -> thing -> HsWildCardBndrs pass thing
Types.HsWC) (Located HsType' -> LHsWcType')
-> (HsType' -> Located HsType') -> HsType' -> LHsWcType'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsType' -> Located HsType'
forall a ann. a -> GenLocated (SrcSpanAnn Any) a
mkLocated

patSigType :: HsType' -> HsPatSigType'
#if MIN_VERSION_ghc(9,2,0)
patSigType = withEpAnnNotUsed mkHsPatSigType . mkLocated
#elif MIN_VERSION_ghc(9,0,0)
patSigType = mkHsPatSigType . builtLoc
#else
patSigType :: HsType' -> LHsSigWcType'
patSigType = HsType' -> LHsSigWcType'
sigWcType
#endif