-- 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 =  forall a. a -> a
withPlaceHolder
                forall a b. (a -> b) -> a -> b
$ forall a. (NoExtField -> a) -> a
noExt (forall a. a -> a
withPlaceHolder forall pass.
XHsQTvs pass -> [LHsTyVarBndr () pass] -> LHsQTyVars pass
HsQTvs)
                forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a ann. a -> GenLocated (SrcSpanAnn ann) a
mkLocated [HsTyVarBndr']
vars

sigType :: HsType' -> LHsSigType'
#if MIN_VERSION_ghc(9,2,0)
sigType :: HsType' -> LHsSigType'
sigType = forall a ann. a -> GenLocated (SrcSpanAnn ann) a
mkLocated forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (NoExtField -> a) -> a
noExt forall pass.
XHsSig pass
-> HsOuterSigTyVarBndrs pass -> LHsType pass -> HsSigType pass
HsSig (forall a. (NoExtField -> a) -> a
noExt forall flag pass.
XHsOuterImplicit pass -> HsOuterTyVarBndrs flag pass
HsOuterImplicit) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a ann. a -> GenLocated (SrcSpanAnn ann) a
mkLocated
#else
sigType = withPlaceHolder . noExt (withPlaceHolder Types.HsIB) . 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 :: LHsType GhcPs -> LHsType GhcPs
parenthesizeTypeForApp LHsType GhcPs
t
    | HsType' -> Bool
needsParenForApp (forall l e. GenLocated l e -> e
unLoc LHsType GhcPs
t) = LHsType GhcPs -> LHsType GhcPs
parTy LHsType GhcPs
t
    | Bool
otherwise = LHsType GhcPs
t
parenthesizeTypeForOp :: LHsType GhcPs -> LHsType GhcPs
parenthesizeTypeForOp LHsType GhcPs
t
    | HsType' -> Bool
needsParenForOp (forall l e. GenLocated l e -> e
unLoc LHsType GhcPs
t) = LHsType GhcPs -> LHsType GhcPs
parTy LHsType GhcPs
t
    | Bool
otherwise = LHsType GhcPs
t
parenthesizeTypeForFun :: LHsType GhcPs -> LHsType GhcPs
parenthesizeTypeForFun LHsType GhcPs
t
    | HsType' -> Bool
needsParenForFun (forall l e. GenLocated l e -> e
unLoc LHsType GhcPs
t) = LHsType GhcPs -> LHsType GhcPs
parTy LHsType GhcPs
t
    | Bool
otherwise = LHsType GhcPs
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 :: LHsType GhcPs -> LHsType GhcPs
parTy = forall a ann. a -> GenLocated (SrcSpanAnn ann) a
mkLocated forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall ann a. (EpAnn ann -> a) -> a
withEpAnnNotUsed forall pass. XParTy pass -> LHsType pass -> HsType pass
HsParTy

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

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

patSigType :: HsType' -> HsPatSigType'
#if MIN_VERSION_ghc(9,2,0)
patSigType :: HsType' -> HsPatSigType'
patSigType = forall ann a. (EpAnn ann -> a) -> a
withEpAnnNotUsed EpAnn EpaLocation -> LHsType GhcPs -> HsPatSigType'
mkHsPatSigType forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a ann. a -> GenLocated (SrcSpanAnn ann) a
mkLocated
#elif MIN_VERSION_ghc(9,0,0)
patSigType = mkHsPatSigType . builtLoc
#else
patSigType = sigWcType
#endif