HAllable

[hs-rrdtool.git] / Data / HList / Prelude.hs

diff --git a/Data/HList/Prelude.hs b/Data/HList/Prelude.hs
index 3ab596ffb1e45c2aacf9484384b5f9334e454f81..d9ee19a89211b532ff20f01e6a0409e7e8eef94a 100644 (file)
--- a/Data/HList/Prelude.hs
+++ b/Data/HList/Prelude.hs
@@ -27,12 +27,14 @@ module Data.HList.Prelude
     , HFoldrable(..)
     , HConcatable(..)
     , HMappable(..)
+    , HAllable(..)
 
-    , HLength(..)
+    , HLength
     )
     where
 
 import Data.Typeable
+import Types.Data.Bool
 import Types.Data.Num hiding ((:*:))
 
 
@@ -157,17 +159,27 @@ instance ( Applyable f x
     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
-class IntegerT (HLengthOf l) => HLength l where
-    type HLengthOf l
-    hLength :: Integral n => l -> n
-
-instance HLength HNil where
-    type HLengthOf HNil = D0
-    hLength _ = 0
-
-instance ( HLength l
-         , IntegerT (Succ (HLengthOf l))
-         ) => HLength (HCons e l) where
-    type HLengthOf (HCons e l) = Succ (HLengthOf l)
-    hLength (HCons _ l) = 1 + hLength l
+type family HLength l
+type instance HLength HNil        = D0
+type instance HLength (HCons e l) = Succ (HLength l)