{-# LANGUAGE CPP #-}

module Data.Inhabited.TH where



import Language.Haskell.TH

import Language.Syntactic.TH



mkTupE :: [Exp] -> Exp
#if __GLASGOW_HASKELL__ >= 810
mkTupE :: [Exp] -> Exp
mkTupE = [Maybe Exp] -> Exp
TupE ([Maybe Exp] -> Exp) -> ([Exp] -> [Maybe Exp]) -> [Exp] -> Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Exp -> Maybe Exp) -> [Exp] -> [Maybe Exp]
forall a b. (a -> b) -> [a] -> [b]
map Exp -> Maybe Exp
forall a. a -> Maybe a
Just
#else
mkTupE = TupE
#endif

inhabitedTupleInstances :: Int -> DecsQ
inhabitedTupleInstances :: Int -> DecsQ
inhabitedTupleInstances Int
n = [Dec] -> DecsQ
forall (m :: * -> *) a. Monad m => a -> m a
return
    [ Cxt -> Type -> [Dec] -> Dec
instD
        [Type -> Type -> Type
AppT (Name -> Type
ConT (String -> Name
mkName String
"Inhabited")) (Name -> Type
VarT Name
a) | Name
a <- Int -> [Name] -> [Name]
forall a. Int -> [a] -> [a]
take Int
w [Name]
varSupply]
        ( Type -> Type -> Type
AppT
            (Name -> Type
ConT (String -> Name
mkName String
"Inhabited"))
            ((Type -> Type -> Type) -> Type -> Cxt -> Type
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Type -> Type -> Type
AppT (Int -> Type
TupleT Int
w) ((Name -> Type) -> [Name] -> Cxt
forall a b. (a -> b) -> [a] -> [b]
map Name -> Type
VarT ([Name] -> Cxt) -> [Name] -> Cxt
forall a b. (a -> b) -> a -> b
$ Int -> [Name] -> [Name]
forall a. Int -> [a] -> [a]
take Int
w [Name]
varSupply))
        )
        [ Name -> [Clause] -> Dec
FunD
            (String -> Name
mkName String
"example")
            [ [Pat] -> Body -> [Dec] -> Clause
Clause
                []
                (Exp -> Body
NormalB (Exp -> Body) -> Exp -> Body
forall a b. (a -> b) -> a -> b
$ [Exp] -> Exp
mkTupE ([Exp] -> Exp) -> [Exp] -> Exp
forall a b. (a -> b) -> a -> b
$ (Name -> Exp) -> [Name] -> [Exp]
forall a b. (a -> b) -> [a] -> [b]
map Name -> Exp
VarE ([Name] -> [Exp]) -> [Name] -> [Exp]
forall a b. (a -> b) -> a -> b
$ Int -> Name -> [Name]
forall a. Int -> a -> [a]
replicate Int
w (String -> Name
mkName String
"example"))
                []
            ]
        ]
      | Int
w <- [Int
2..Int
n]
    ]