{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE QuasiQuotes #-}

module Common where
-- Common Utility Functions

import Language.Haskell.TH


------------
-- Tuples --
------------

fst3 :: (a,b,c) -> a
fst3 (x,_,_) = x
snd3 :: (a,b,c) -> b
snd3 (_,y,_) = y
trd3 :: (a,b,c) -> c
trd3 (_,_,z) = z

projNI :: Int -> Int -> ExpQ -- generic projection gives I-th element of N-tuple, i.e. snd3 = $(projNI 3 2)  --ghci -fth
-- $(projN n m) :: (t1,..,tn) -> tm (for m<=n)
projNI n i = lamE [pat] rhs
  where pat = tupP (map varP xs)
        rhs = varE (xs !! (i - 1))
        xs  = [ mkName $ "x" ++ show j | j <- [1..n] ]
        
        
---------------
-- Functions --
---------------

permuteFun :: [Int] -> ExpQ -- generic permutation of function arguments, i.e. $(permuteFun [2,1]) == flip
permuteFun perm = lamE pat rhs
  where pat = map varP $ fn:xs
        rhs = foldl appE (varE fn) $ map varE ps
--         rhs = appE (varE fn) (varE $ xs!!1)
        ln  = length perm   
        xs  = [ mkName $ "x" ++ show j | j <- [1..ln] ]
        ps  = [ xs !! (j-1) | j <- perm ]
        fn  = mkName "fn" 

altFun :: [Int] -> ExpQ -- generic permutation/repetition of function arguments, i.e. $(permuteFun [2,1]) == flip
altFun perm = lamE pat rhs
  where pat = map varP $ fn:xs
        rhs = foldl appE (varE fn) $ map varE ps
--         rhs = appE (varE fn) (varE $ xs!!1)        
        mx  = maximum perm
        xs  = [ mkName $ "x" ++ show j | j <- [1..mx] ]
        ps  = [ xs !! (j-1) | j <- perm ]
        fn  = mkName "fn"