[Fencommits] fenserve: more generic tooling for processing tuples as heterogeneous lists

[Benja Fallenstein]

Mon Jun  4 04:30:48 EEST 2007  Benja Fallenstein <benja.fallenstein at gmail.com>
  * more generic tooling for processing tuples as heterogeneous lists
diff -rN -u old-fenserve/fendata/HListUtils.hs new-fenserve/fendata/HListUtils.hs
--- old-fenserve/fendata/HListUtils.hs	1970-01-01 02:00:00.000000000 +0200
+++ new-fenserve/fendata/HListUtils.hs	2007-06-04 12:04:36.000000000 +0300
@@ -0,0 +1,33 @@
+{-# OPTIONS_GHC -fglasgow-exts #-}
+
+module HListUtils where
+
+infixr 5 :*:
+
+data a :*: b = a :*: b
+data Nil = Nil
+
+class ToHList a l | a -> l where toHList :: a -> l
+
+instance ToHList () Nil where
+    toHList () = Nil
+    
+instance ToHList (a,b) (a:*:b:*:Nil) where
+    toHList (a,b) = a :*: b :*: Nil
+instance ToHList (a,b,c) (a:*:b:*:c:*:Nil) where
+    toHList (a,b,c) = a :*: b :*: c :*: Nil
+instance ToHList (a,b,c,d) (a:*:b:*:c:*:d:*:Nil) where
+    toHList (a,b,c,d) = a :*: b :*: c :*: d :*: Nil
+instance ToHList (a,b,c,d,e) (a:*:b:*:c:*:d:*:e:*:Nil) where
+    toHList (a,b,c,d,e) = a :*: b :*: c :*: d :*: e :*: Nil
+instance ToHList (a,b,c,d,e,f) (a:*:b:*:c:*:d:*:e:*:f:*:Nil) where
+    toHList (a,b,c,d,e,f) = a :*: b :*: c :*: d :*: e :*: f :*: Nil
+instance ToHList (a,b,c,d,e,f,g) (a:*:b:*:c:*:d:*:e:*:f:*:g:*:Nil) where
+    toHList (a,b,c,d,e,f,g) = a :*: b :*: c :*: d :*: e :*: f :*: g :*: Nil
+instance ToHList (a,b,c,d,e,f,g,h) (a:*:b:*:c:*:d:*:e:*:f:*:g:*:h:*:Nil) where
+    toHList (a,b,c,d,e,f,g,h) = a:*:b:*:c:*:d:*:e:*:f:*:g:*:h:*:Nil
+instance ToHList (a,b,c,d,e,f,g,h,i) (a:*:b:*:c:*:d:*:e:*:f:*:g:*:h:*:i:*:Nil) where
+    toHList (a,b,c,d,e,f,g,h,i) = a:*:b:*:c:*:d:*:e:*:f:*:g:*:h:*:i:*:Nil
+instance ToHList (a,b,c,d,e,f,g,h,i,j) (a:*:b:*:c:*:d:*:e:*:f:*:g:*:h:*:i:*:j:*:Nil) where
+    toHList (a,b,c,d,e,f,g,h,i,j) = a:*:b:*:c:*:d:*:e:*:f:*:g:*:h:*:i:*:j:*:Nil
+
diff -rN -u old-fenserve/fendata/HTML.hs new-fenserve/fendata/HTML.hs
--- old-fenserve/fendata/HTML.hs	2007-06-04 12:04:36.000000000 +0300
+++ new-fenserve/fendata/HTML.hs	2007-06-04 12:04:36.000000000 +0300
@@ -2,6 +2,8 @@
 
 module HTML where
 
+import HListUtils
+
 import HAppS (lookM)
 
 import Data.Generics (Typeable, Data)
@@ -45,22 +47,13 @@
 instance ToHTML String where
     toHTML = HTML . concatMap quoteChar
     
-instance (ToHTML a, ToHTML b) => ToHTML (a,b) where
-    toHTML (a,b) = a & b
-instance (ToHTML a, ToHTML (b,c)) => ToHTML (a,b,c) where
-    toHTML (a,b,c) = a & (b,c)
-instance (ToHTML a, ToHTML (b,c,d)) => ToHTML (a,b,c,d) where
-    toHTML (a,b,c,d) = a & (b,c,d)
-instance (ToHTML a, ToHTML (b,c,d,e)) => ToHTML (a,b,c,d,e) where
-    toHTML (a,b,c,d,e) = a & (b,c,d,e)
-instance (ToHTML a, ToHTML (b,c,d,e,f)) => ToHTML (a,b,c,d,e,f) where
-    toHTML (a,b,c,d,e,f) = a & (b,c,d,e,f)
-instance (ToHTML a, ToHTML (b,c,d,e,f,g)) => ToHTML (a,b,c,d,e,f,g) where
-    toHTML (a,b,c,d,e,f,g) = a & (b,c,d,e,f,g)
-instance (ToHTML a, ToHTML (b,c,d,e,f,g,h)) => ToHTML (a,b,c,d,e,f,g,h) where
-    toHTML (a,b,c,d,e,f,g,h) = a & (b,c,d,e,f,g,h)
-instance (ToHTML a, ToHTML (b,c,d,e,f,g,h,i)) => ToHTML (a,b,c,d,e,f,g,h,i) where
-    toHTML (a,b,c,d,e,f,g,h,i) = a & (b,c,d,e,f,g,h,i)
+class HCat a where hCat :: a -> HTML
+instance HCat Nil where hCat Nil = HTML ""
+instance (ToHTML x, HCat xs) => HCat (x :*: xs) where 
+    hCat (x :*: xs) = x & hCat xs
+    
+instance (ToHList a l, HCat l) => ToHTML a where
+    toHTML a = hCat (toHList a)
 
 instance ToString String where toString = id
 instance Show a => ToString a where toString = show