X-Git-Url: http://git.cielonegro.org/gitweb.cgi?a=blobdiff_plain;ds=sidebyside;f=Data%2FHList%2FPrelude.hs;h=d9ee19a89211b532ff20f01e6a0409e7e8eef94a;hb=3ac7657c591da8c12909fd3a5eb3b07d835c8e93;hp=b3a88fdb0c2371d20828f9ecf802f993a431d264;hpb=135df1a5d8a159db412614bcfc25634bee201f94;p=hs-rrdtool.git

diff --git a/Data/HList/Prelude.hs b/Data/HList/Prelude.hs
index b3a88fd..d9ee19a 100644
--- a/Data/HList/Prelude.hs
+++ b/Data/HList/Prelude.hs
@@ -1,3 +1,11 @@
+{-# LANGUAGE DeriveDataTypeable,
+             FlexibleContexts,
+             FlexibleInstances,
+             MultiParamTypeClasses,
+             TypeFamilies,
+             TypeOperators,
+             UndecidableInstances
+  #-}
 module Data.HList.Prelude
     ( HList
 
@@ -19,10 +27,15 @@ module Data.HList.Prelude
     , HFoldrable(..)
     , HConcatable(..)
     , HMappable(..)
+    , HAllable(..)
+
+    , HLength
     )
     where
 
 import Data.Typeable
+import Types.Data.Bool
+import Types.Data.Num hiding ((:*:))
 
 
 -- HList
@@ -145,3 +158,28 @@ instance ( Applyable f x
          ) => HMappable f (HCons x xs) where
     type HMap f (HCons x xs) = HCons (Apply f x) (HMap f xs)
     hMap f (HCons x xs) = hCons (apply f x) (hMap f xs)
+
+-- HAllable
+class HAllable f l where
+    type HAll f l
+    hAll :: f -> l -> HAll f l
+
+instance HAllable f HNil where
+    type HAll f HNil = True
+    hAll _ _ = undefined :: True
+
+instance ( IfT (Apply f x) (HAll f xs) False
+         , Applyable f x
+         , HAllable f xs
+         ) => HAllable f (HCons x xs) where
+    type HAll f (HCons x xs) = If (Apply f x)
+                                 (HAll f xs)
+                                 False
+    hAll f (HCons x xs) = ifT (apply f x)
+                                 (hAll f xs)
+                                 (undefined :: False)
+
+-- HLength
+type family HLength l
+type instance HLength HNil        = D0
+type instance HLength (HCons e l) = Succ (HLength l)