{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE TemplateHaskellQuotes #-}
{-# LANGUAGE LambdaCase #-}
{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}

module Template.Tools where

import Language.Haskell.TH

tupT' :: [TypeQ] -> TypeQ
tupT' :: [TypeQ] -> TypeQ
tupT' = \case [TypeQ
n] -> TypeQ
n; [TypeQ]
ns -> (TypeQ -> TypeQ -> TypeQ) -> TypeQ -> [TypeQ] -> TypeQ
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl TypeQ -> TypeQ -> TypeQ
forall (m :: * -> *). Quote m => m Type -> m Type -> m Type
appT (Int -> TypeQ
forall (m :: * -> *). Quote m => Int -> m Type
tupleT (Int -> TypeQ) -> Int -> TypeQ
forall a b. (a -> b) -> a -> b
$ [TypeQ] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [TypeQ]
ns) [TypeQ]
ns

tupP' :: [PatQ] -> PatQ
tupP' :: [PatQ] -> PatQ
tupP' = \case [PatQ
p] -> PatQ
p; [PatQ]
ps -> [PatQ] -> PatQ
forall (m :: * -> *). Quote m => [m Pat] -> m Pat
tupP [PatQ]
ps

tupE' :: [ExpQ] -> ExpQ
tupE' :: [ExpQ] -> ExpQ
tupE' = \case [ExpQ
e] -> ExpQ
e; [ExpQ]
es -> [ExpQ] -> ExpQ
forall (m :: * -> *). Quote m => [m Exp] -> m Exp
tupE [ExpQ]
es

infixr 7 `arrT`

arrT :: TypeQ -> TypeQ -> TypeQ
TypeQ
t1 arrT :: TypeQ -> TypeQ -> TypeQ
`arrT` TypeQ
t2 = TypeQ
forall (m :: * -> *). Quote m => m Type
arrowT TypeQ -> TypeQ -> TypeQ
forall (m :: * -> *). Quote m => m Type -> m Type -> m Type
`appT` TypeQ
t1 TypeQ -> TypeQ -> TypeQ
forall (m :: * -> *). Quote m => m Type -> m Type -> m Type
`appT` TypeQ
t2

infixr 7 `comE`

comE :: ExpQ -> ExpQ -> ExpQ
ExpQ
e1 comE :: ExpQ -> ExpQ -> ExpQ
`comE` ExpQ
e2 = Maybe ExpQ -> ExpQ -> Maybe ExpQ -> ExpQ
forall (m :: * -> *).
Quote m =>
Maybe (m Exp) -> m Exp -> Maybe (m Exp) -> m Exp
infixE (ExpQ -> Maybe ExpQ
forall a. a -> Maybe a
Just ExpQ
e1) (Name -> ExpQ
forall (m :: * -> *). Quote m => Name -> m Exp
varE '(.)) (ExpQ -> Maybe ExpQ
forall a. a -> Maybe a
Just ExpQ
e2)

infixr 5 `fmapE`

fmapE :: ExpQ -> ExpQ -> ExpQ
ExpQ
e1 fmapE :: ExpQ -> ExpQ -> ExpQ
`fmapE` ExpQ
e2 = Maybe ExpQ -> ExpQ -> Maybe ExpQ -> ExpQ
forall (m :: * -> *).
Quote m =>
Maybe (m Exp) -> m Exp -> Maybe (m Exp) -> m Exp
infixE (ExpQ -> Maybe ExpQ
forall a. a -> Maybe a
Just ExpQ
e1) (Name -> ExpQ
forall (m :: * -> *). Quote m => Name -> m Exp
varE '(<$>)) (ExpQ -> Maybe ExpQ
forall a. a -> Maybe a
Just ExpQ
e2)