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

module Template.Tools where

import Language.Haskell.TH
import Language.Haskell.TH.Syntax
import Data.Char

import Data.SwizzleModify.Base.Pkg qualified as Pkg

clsSwizzle :: Int -> TypeQ
clsSwizzle :: Int -> TypeQ
clsSwizzle = Name -> TypeQ
forall (m :: * -> *). Quote m => Name -> m Type
conT
	(Name -> TypeQ) -> (Int -> Name) -> Int -> TypeQ
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String -> Name
mkNameG_tc String
Pkg.swizzleClassPkg String
"Data.Swizzle.Class.Base"
	(String -> Name) -> (Int -> String) -> Int -> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"Swizzle" String -> String -> String
forall a. [a] -> [a] -> [a]
++) (String -> String) -> (Int -> String) -> Int -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String
forall a. Show a => a -> String
show

typX :: Char -> TypeQ
typX :: Char -> TypeQ
typX = Name -> TypeQ
forall (m :: * -> *). Quote m => Name -> m Type
conT
	(Name -> TypeQ) -> (Char -> Name) -> Char -> TypeQ
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String -> Name
mkNameG_tc String
Pkg.swizzleClassPkg String
"Data.Swizzle.Class.Base"
	(String -> Name) -> (Char -> String) -> Char -> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> String -> String
forall a. a -> [a] -> [a]
: String
"") (Char -> String) -> (Char -> Char) -> Char -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Char
toUpper

funX :: Char -> ExpQ
funX :: Char -> ExpQ
funX = Name -> ExpQ
forall (m :: * -> *). Quote m => Name -> m Exp
varE (Name -> ExpQ) -> (Char -> Name) -> Char -> ExpQ
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String -> Name
mkNameG_v String
Pkg.swizzleClassPkg String
"Data.Swizzle.Class.Base" (String -> Name) -> (Char -> String) -> Char -> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> String -> String
forall a. a -> [a] -> [a]
: String
"")

clsSwizzleSet :: Int -> TypeQ
clsSwizzleSet :: Int -> TypeQ
clsSwizzleSet = Name -> TypeQ
forall (m :: * -> *). Quote m => Name -> m Type
conT
	(Name -> TypeQ) -> (Int -> Name) -> Int -> TypeQ
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String -> Name
mkNameG_tc String
Pkg.swizzleSetClassPkg String
"Data.SwizzleSet.Class.Base"
	(String -> Name) -> (Int -> String) -> Int -> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"SwizzleSet" String -> String -> String
forall a. [a] -> [a] -> [a]
++) (String -> String) -> (Int -> String) -> Int -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String
forall a. Show a => a -> String
show

typSetX :: Char -> TypeQ
typSetX :: Char -> TypeQ
typSetX = Name -> TypeQ
forall (m :: * -> *). Quote m => Name -> m Type
conT
	(Name -> TypeQ) -> (Char -> Name) -> Char -> TypeQ
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String -> Name
mkNameG_tc String
Pkg.swizzleSetClassPkg String
"Data.SwizzleSet.Class.Base"
	(String -> Name) -> (Char -> String) -> Char -> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> String -> String
forall a. a -> [a] -> [a]
: String
"") (Char -> String) -> (Char -> Char) -> Char -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Char
toUpper

funSetX :: Char -> ExpQ
funSetX :: Char -> ExpQ
funSetX = Name -> ExpQ
forall (m :: * -> *). Quote m => Name -> m Exp
varE
	(Name -> ExpQ) -> (Char -> Name) -> Char -> ExpQ
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String -> Name
mkNameG_v String
Pkg.swizzleSetClassPkg String
"Data.SwizzleSet.Class.Base"
	(String -> Name) -> (Char -> String) -> Char -> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> String -> String
forall a. a -> [a] -> [a]
: String
"")

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)