{-# LANGUAGE CPP #-}
#if __GLASGOW_HASKELL__ >= 800
{-# LANGUAGE TemplateHaskellQuotes #-}
#endif
-- | This module provides TH helpers,
-- which use 'Solo' from this package, for 1-tuples.
module Data.Tuple.Solo.TH (
    tupE,
) where


#if MIN_VERSION_template_haskell(2,17,0)
import Language.Haskell.TH (tupE)
#else
import Data.Tuple.Solo

import qualified Language.Haskell.TH as TH
import qualified Language.Haskell.TH.Syntax as TH

makeTup :: [TH.Exp] -> TH.Exp
makeTup :: [Exp] -> Exp
makeTup [Exp
x] = Exp -> Exp -> Exp
TH.AppE (Name -> Exp
TH.ConE Name
soloConName) Exp
x
#if MIN_VERSION_template_haskell(2,16,0)
makeTup [Exp]
xs  = [Maybe Exp] -> Exp
TH.TupE ((Exp -> Maybe Exp) -> [Exp] -> [Maybe Exp]
forall a b. (a -> b) -> [a] -> [b]
map Exp -> Maybe Exp
forall a. a -> Maybe a
Just [Exp]
xs)
#else
makeTup xs  = TH.TupE xs
#endif

soloConName :: TH.Name
#if __GLASGOW_HASKELL__ >= 800
soloConName :: Name
soloConName = 'Solo
#else
#ifndef CURRENT_PACKAGE_KEY 
#error "CURRENT_PACKAGE_KEY undefined"
#endif

soloConName = TH.mkNameG_d CURRENT_PACKAGE_KEY "Data.Tuple.Solo" "Solo"
#endif

tupE :: Monad m => [m TH.Exp] -> m TH.Exp
tupE :: [m Exp] -> m Exp
tupE [m Exp]
xs = do
    [Exp]
xs' <- [m Exp] -> m [Exp]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [m Exp]
xs
    Exp -> m Exp
forall (m :: * -> *) a. Monad m => a -> m a
return ([Exp] -> Exp
makeTup [Exp]
xs')
#endif