content: {-# LANGUAGE CPP #-}
  -- 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
  
  -- | This module provides combinators for constructing Haskell types.
  module GHC.SourceGen.Type
      ( HsType'
      , tyPromotedVar
      , stringTy
      , numTy
      , listTy
      , listPromotedTy
      , tuplePromotedTy
      , (-->)
      , forall'
      , HsTyVarBndr'
      , (==>)
      , kindedVar
      ) where
  
  import Data.String (fromString)
  #if MIN_VERSION_ghc(9,0,0)
  import GHC.Hs.Type
  import GHC.Parser.Annotation
  #else
  import GHC.Hs.Type
  #endif
  
  #if MIN_VERSION_ghc(9,4,0)
  import Language.Haskell.Syntax.Extension
  #endif
  #if MIN_VERSION_ghc(9,12,0)
  import Language.Haskell.Syntax.Type
  #endif
  
  import GHC.SourceGen.Syntax.Internal
  import GHC.SourceGen.Lit.Internal (noSourceText)
  import GHC.SourceGen.Name.Internal
  import GHC.SourceGen.Type.Internal
  
  -- | A promoted name, for example from the @DataKinds@ extension.
  tyPromotedVar :: RdrNameStr -> HsType'
  #if MIN_VERSION_ghc(9,10,0)
  tyPromotedVar = HsTyVar noAnn promoted . typeRdrName
  #else
  tyPromotedVar = withEpAnnNotUsed HsTyVar promoted . typeRdrName
  #endif
  
  stringTy :: String -> HsType'
  stringTy = noExt HsTyLit . noSourceText HsStrTy . fromString
  
  numTy :: Integer -> HsType'
  numTy = noExt HsTyLit . noSourceText HsNumTy
  
  listTy :: HsType' -> HsType'
  #if MIN_VERSION_ghc(9,10,0)
  listTy = HsListTy noAnn . mkLocated
  #else
  listTy = withEpAnnNotUsed HsListTy . mkLocated
  #endif
  
  listPromotedTy :: [HsType'] -> HsType'
  -- Lists of two or more elements don't need the explicit tick (`'`).
  -- But for consistency, just always add it.
  #if MIN_VERSION_ghc(9,10,0)
  listPromotedTy = withPlaceHolder (HsExplicitListTy noAnn promoted) . map mkLocated
  #else
  listPromotedTy = withPlaceHolder (withEpAnnNotUsed HsExplicitListTy promoted) . map mkLocated
  #endif
  
  tuplePromotedTy :: [HsType'] -> HsType'
  #if MIN_VERSION_ghc(9,12,0)
  tuplePromotedTy = withPlaceHolders (HsExplicitTupleTy noAnn IsPromoted) . map mkLocated
  #elif MIN_VERSION_ghc(9,10,0)
  tuplePromotedTy = withPlaceHolders (withEpAnnNotUsed (HsExplicitTupleTy [])) . map mkLocated
  #else
  tuplePromotedTy = withPlaceHolders (withEpAnnNotUsed HsExplicitTupleTy) . map mkLocated
  #endif
  
  -- | A function type.
  --
  -- > a -> b
  -- > =====
  -- > var "a" --> var "b"
  (-->) :: HsType' -> HsType' -> HsType'
  a --> b =
  #if MIN_VERSION_ghc(9,10,0)
       (noExt HsFunTy)
           --(HsUnannotated (EpArrow (EpUniTok noSpanAnchor NormalSyntax)))
           (HsUnrestrictedArrow (EpUniTok noSpanAnchor NormalSyntax))
  #elif MIN_VERSION_ghc(9,4,0)
       withEpAnnNotUsed HsFunTy
           (HsUnrestrictedArrow mkUniToken)
  #elif MIN_VERSION_ghc(9,0,0)
       withEpAnnNotUsed HsFunTy
           (HsUnrestrictedArrow NormalSyntax)
  #else
       withEpAnnNotUsed HsFunTy
  #endif
           (parenthesizeTypeForFun $ mkLocated a) (mkLocated b)
  
  infixr 0 -->
  
  -- | A type variable binding.
  --
  -- > forall a . T a
  -- > =====
  -- > forall' [bvar "a"] $ var "T" @@ var "a"
  forall' :: [HsTyVarBndrS'] -> HsType' -> HsType'
  #if MIN_VERSION_ghc(9,10,0)
  forall' ts t =
      HsForAllTy
          NoExtField
          (mkHsForAllInvisTele ann (map mkLocated ts))
          (mkLocated t)
    where
      ann = EpAnn noSpanAnchor (noAnn, noAnn) emptyComments
  #elif MIN_VERSION_ghc(9,2,0)
  forall' ts = noExt hsForAllTy (map mkLocated ts) . mkLocated
    where
      hsForAllTy x = HsForAllTy x . withEpAnnNotUsed mkHsForAllInvisTele
  #elif MIN_VERSION_ghc(9,0,0)
  forall' ts = noExt hsForAllTy (map mkLocated ts) . mkLocated
    where
      hsForAllTy x = HsForAllTy x . mkHsForAllInvisTele
  #elif MIN_VERSION_ghc(8,10,0)
  forall' ts = noExt hsForAllTy (map mkLocated ts) . mkLocated
    where
      fvf = ForallInvis -- "Invisible" forall, i.e., with a dot
      hsForAllTy x = HsForAllTy x fvf
  #else
  forall' ts = noExt hsForAllTy (map mkLocated ts) . mkLocated
    where
      hsForAllTy = HsForAllTy
  #endif
  
  -- | Qualify a type with constraints.
  --
  -- > (F x, G x) => x
  -- > =====
  -- > [var "F" @@ var "x", var "G" @@ var "x"] ==> var "x"
  (==>) :: [HsType'] -> HsType' -> HsType'
  (==>) cs = hsQualTy (mkLocated (map mkLocated cs)) . mkLocated
    where
  #if MIN_VERSION_ghc(9,4,0)
      hsQualTy = noExt HsQualTy
  #elif MIN_VERSION_ghc(9,2,0)
      hsQualTy = noExt HsQualTy . Just
  #else
      hsQualTy = noExt HsQualTy
  #endif
  
  infixr 0 ==>
  
  -- | A type variable with a kind signature.
  --
  -- > x :: A
  -- > =====
  -- > kindedVar "x" (var "A")
  kindedVar :: OccNameStr -> HsType' -> HsTyVarBndr'
  kindedVar v t =
  #if MIN_VERSION_ghc(9,12,0)
              HsTvb noAnn (noExt HsBndrRequired) (noExt HsBndrVar $ typeRdrName $ UnqualStr v) (noExt HsBndrKind $ mkLocated t)
  #elif MIN_VERSION_ghc(9,10,0)
              KindedTyVar
                  []
                  (noExt HsBndrRequired)
                  (typeRdrName $ UnqualStr v) (mkLocated t)
  #elif MIN_VERSION_ghc(9,8,0)
              withEpAnnNotUsed KindedTyVar
                  HsBndrRequired
                  (typeRdrName $ UnqualStr v) (mkLocated t)
  #elif MIN_VERSION_ghc(9,0,0)
              withEpAnnNotUsed KindedTyVar
                  ()
                  (typeRdrName $ UnqualStr v) (mkLocated t)
  #else
              withEpAnnNotUsed KindedTyVar
                  (typeRdrName $ UnqualStr v) (mkLocated t)
  #endif
  