[Fencommits] fenserve: more refactoring of the tuples-as-hlists stuff

[Benja Fallenstein]

Sat Jun  9 16:36:53 EEST 2007  Benja Fallenstein <benja.fallenstein at gmail.com>
  * more refactoring of the tuples-as-hlists stuff
diff -rN -u old-fenserve/fendata/Potions.hs new-fenserve/fendata/Potions.hs
--- old-fenserve/fendata/Potions.hs	2007-06-09 16:37:03.000000000 +0300
+++ new-fenserve/fendata/Potions.hs	2007-06-09 16:37:03.000000000 +0300
@@ -23,10 +23,9 @@
 class Typeable b => ToTemplate a b where template :: a -> Template b
 instance (ToHTML h, Typeable a) => ToTemplate (Identity h) a where
     template (Identity h) = TNil (toHTML h)
-instance (ToHTML h, Tuple h t' t, Typeable a, Tuple a xs t', ToTemplate xs a)
+instance (ToHTML h, Typeable a, Tuple h t' t, Tuple a xs t', ToTemplate xs a)
          => ToTemplate t a where
-    template t | (h,t') <- tsplit t, (x,xs) <- tsplit t' =
-        TCons (toHTML h) x (template xs)
+    template t | (h,x,xs) <- tsplit2 t = TCons (toHTML h) x (template xs)
 
 
 --renderTemplate :: Typeable a => (a -> HTML) -> Template a -> HTML
diff -rN -u old-fenserve/fendata/TupleUtils.hs new-fenserve/fendata/TupleUtils.hs
--- old-fenserve/fendata/TupleUtils.hs	2007-06-09 16:37:03.000000000 +0300
+++ new-fenserve/fendata/TupleUtils.hs	2007-06-09 16:37:03.000000000 +0300
@@ -1,6 +1,7 @@
-{-# OPTIONS_GHC -fglasgow-exts #-}
+{-# OPTIONS_GHC -fglasgow-exts -fallow-undecidable-instances #-}
 
-module TupleUtils (Tuple, (.*.), thead, ttail, tsplit, Identity(..)) where
+module TupleUtils (Tuple(..), tsplit1, tsplit2, tsplit3,
+                   TAppend(..), Identity(..)) where
 
 import Control.Monad.Identity
 
@@ -11,8 +12,23 @@
     thead :: t -> x
     ttail :: t -> xs
 
-    tsplit :: t -> (x,xs)
-    tsplit t = (thead t, ttail t)
+tsplit1 :: Tuple x t xt => xt -> (x,t)
+tsplit1 t = (thead t, ttail t)
+
+tsplit2 :: (Tuple x yt xyt, Tuple y t yt) => xyt -> (x,y,t)
+tsplit2 t = (thead t, thead $ ttail t, ttail $ ttail t)
+
+tsplit3 :: (Tuple x yzt xyzt, Tuple y zt yzt, Tuple z t zt) => xyzt -> (x,y,z,t)
+tsplit3 t = (thead t, thead $ ttail t, thead $ ttail $ ttail t, ttail $ ttail $ ttail t)
+    
+
+class TAppend xs ys zs | xs ys -> zs, xs zs -> ys, ys zs -> xs where
+    tappend :: xs -> ys -> zs
+instance TAppend xs () xs where tappend xs () = xs
+instance (Tuple x xs xxs, TAppend xs ys zs, Tuple x zs xzs) =>
+         TAppend xxs ys xzs where
+    tappend xxs ys | (x,xs) <- tsplit1 xxs = x .*. tappend xs ys
+    
     
 instance Tuple a () (Identity a) where
     x .*. () = Identity x