[Haskell-cafe] Template Haskell - substitution in pattern in a lambda

[Patrick Caldon]

I'm trying to write some template haskell which will transform:

$(buildCP 0)  into \(SimpleM d1 d2 d3) (SimpleM _ _ _) -> (SimpleM d1 d2 d3)
$(buildCP 1)  into \(SimpleM _ d2 d3) (SimpleM d1 _ _) -> (SimpleM d1 d2 d3)
$(buildCP 1)  into \(SimpleM d1 _ d3) (SimpleM _ d2 _) -> (SimpleM d1 d2 d3)
and so on.

Ultimately I want to generalize this to more variables.

I can't seem to get anything to substitute for the pattern variables in 
a lambda.  Is there a straightforward way of doing this?

Below is what I've been playing with to try to make this work.

Thanks,
Patrick.


---
module THTest where

import Language.Haskell.TH
import qualified Data.Bits

type Policy = Int

data Management = SimpleM Policy Policy Policy
    deriving Show

-- Compiles - but no substitution for the "aX" and "bX" variables
buildCP :: Int -> ExpQ
buildCP k =
    [|\(SimpleM a1 a2 a3) (SimpleM b1 b2 b3) -> (SimpleM $e1 $e2 $e3) |]
    where (e1,a1,b1) = bitToExprs 0 k
          (e2,a2,b2) = bitToExprs 1 k
          (e3,a3,b3) = bitToExprs 2 k


-- Won't compile:

buildCP2 :: Int -> ExpQ
buildCP2 k =
    [|\(SimpleM $a1 $a2 $a3) (SimpleM $b1 $b2 $b3) -> (SimpleM $e1 $e2 
$e3) |]
    where (e1,a1,b1) = bitToExprs 0 k
          (e2,a2,b2) = bitToExprs 1 k
          (e3,a3,b3) = bitToExprs 2 k

cp1 0 = \(SimpleM d1 d2 d3) (SimpleM _ _ _) -> (SimpleM d1 d2 d3)

{-
-- idea is to use in calls like this:

cp0 0 = $(buildCP 0) -- should be \(SimpleM d1 d2 d3) (SimpleM _ _ _) -> 
(SimpleM d1 d2 d3)
cp0 1 = $(buildCP 1)
-}

-- There is also a template haskell [p| ... |] syntax, but not yet 
implemented ...
bitToExprs:: Int -> Int -> (ExpQ,PatQ,PatQ)
bitToExprs n k =
    if Data.Bits.testBit (k::Int) (n::Int)
    then (e,v1,v2)
    else (e,v2,v1)
    where v1 =  return WildP
          v2 =  return $ VarP (mkName name)
          e = return $ VarE (mkName name)
          name = "d" ++ (show $ n + 1)

{-

-- ulitmate goal is something like this with 10ish d variables:
-- 

cp0 0 (SimpleM d1 d2 d3 m1) (SimpleM _ _ _ m2) = (SimpleM d1 d2 d3 (me1 
m1 m2))
cp0 1 (SimpleM d1 d2 _ m1) (SimpleM _ _ d3 m2) = (SimpleM d1 d2 d3 (me2 
m1 m2))
cp0 2 (SimpleM d1 _ d3 m1) (SimpleM _ d2 _ m2) = (SimpleM d1 d2 d3 (me1 
m1 m2))
cp0 3 (SimpleM d1 _ _ m1) (SimpleM _ d2 d3 m2) = (SimpleM d1 d2 d3 (me2 
m1 m2))
cp0 4 (SimpleM _ d2 d3 m1) (SimpleM d1 _ _ m2) = (SimpleM d1 d2 d3 (me1 
m1 m2))
cp0 5 (SimpleM _ d2 _ m1) (SimpleM d1 _ d3 m2) = (SimpleM d1 d2 d3 (me2 
m1 m2))
cp0 6 (SimpleM _ _ d3 m1) (SimpleM d1 d2 _ m2) = (SimpleM d1 d2 d3 (me1 
m1 m2))
cp0 7 (SimpleM _ _ _ m1) (SimpleM d1 d2 d3 m2) = (SimpleM d1 d2 d3 (me2 
m1 m2))
cp0 _ _ _ = (trace "cp0 error" undefined)

-}