-- 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.Types as Types
import SrcLoc (Located, unLoc)

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 -> [Located HsTyVarBndr'] -> LHsQTyVars')
-> [Located HsTyVarBndr'] -> LHsQTyVars'
forall a. (NoExtField -> a) -> a
noExt ((NoExtField -> [Located HsTyVarBndr'] -> LHsQTyVars')
-> NoExtField -> [Located HsTyVarBndr'] -> LHsQTyVars'
forall a. a -> a
withPlaceHolder NoExtField -> [Located HsTyVarBndr'] -> LHsQTyVars'
forall pass. XHsQTvs pass -> [LHsTyVarBndr pass] -> LHsQTyVars pass
HsQTvs)
                ([Located HsTyVarBndr'] -> LHsQTyVars')
-> [Located HsTyVarBndr'] -> LHsQTyVars'
forall a b. (a -> b) -> a -> b
$ (HsTyVarBndr' -> Located HsTyVarBndr')
-> [HsTyVarBndr'] -> [Located HsTyVarBndr']
forall a b. (a -> b) -> [a] -> [b]
map HsTyVarBndr' -> Located HsTyVarBndr'
forall e. e -> Located e
builtLoc [HsTyVarBndr']
vars

sigType :: HsType' -> LHsSigType'
sigType :: HsType' -> LHsSigType'
sigType = Located HsType' -> LHsSigType'
forall t. t -> HsImplicitBndrs' t
implicitBndrs (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

implicitBndrs :: t -> HsImplicitBndrs' t
implicitBndrs :: t -> HsImplicitBndrs' t
implicitBndrs = HsImplicitBndrs' t -> HsImplicitBndrs' t
forall a. a -> a
withPlaceHolder (HsImplicitBndrs' t -> HsImplicitBndrs' t)
-> (t -> HsImplicitBndrs' t) -> t -> HsImplicitBndrs' t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NoExtField -> t -> HsImplicitBndrs' t) -> t -> HsImplicitBndrs' t
forall a. (NoExtField -> a) -> a
noExt ((NoExtField -> t -> HsImplicitBndrs' t)
-> NoExtField -> t -> HsImplicitBndrs' t
forall a. a -> a
withPlaceHolder NoExtField -> t -> HsImplicitBndrs' t
forall pass thing.
XHsIB pass thing -> thing -> HsImplicitBndrs pass thing
Types.HsIB)


-- 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
    :: Located HsType' -> Located HsType'
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 :: Located HsType' -> Located HsType'
parTy :: Located HsType' -> Located HsType'
parTy = HsType' -> Located HsType'
forall e. e -> Located e
builtLoc (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
noExt 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 e. e -> Located e
builtLoc