Data/HList/Prelude.hs

   1 module Data.HList.Prelude
   2     ( HList
   3
   4     , HNil(..)
   5     , hNil
   6
   7     , HCons(..)
   8     , hCons
   9
  10     , HExtendable(..)
  11     , HAppendable(..)
  12
  13     , Applyable(..)
  14     , Applyable2(..)
  15
  16     , Id(..)
  17     , ApplyHAppend(..)
  18
  19     , HFoldrable(..)
  20     , HConcatable(..)
  21     , HMappable(..)
  22     )
  23     where
  24
  25 import Data.Typeable
  26
  27
  28 -- HList
  29 class HList l
  30
  31 -- HNil
  32 data HNil
  33     = HNil
  34       deriving (Show, Eq, Ord, Read, Typeable)
  35
  36 instance HList HNil
  37
  38 hNil :: HNil
  39 hNil = HNil
  40
  41 -- HCons
  42 data HCons e l
  43     = HCons e l
  44       deriving (Show, Eq, Ord, Read, Typeable)
  45
  46 instance HList l => HList (HCons e l)
  47
  48 hCons :: HList l => e -> l -> HCons e l
  49 hCons = HCons
  50
  51 -- HExtendable
  52 infixr 2 :*:
  53 infixr 2 .*.
  54
  55 class HExtendable e l where
  56     type e :*: l
  57     (.*.) :: e -> l -> e :*: l
  58
  59 instance HExtendable e HNil where
  60     type e :*: HNil = HCons e HNil
  61     e .*. nil = hCons e nil
  62
  63 instance HList l => HExtendable e (HCons e' l) where
  64     type e :*: HCons e' l = HCons e (HCons e' l)
  65     e .*. HCons e' l = hCons e (hCons e' l)
  66
  67 -- HAppendable
  68 infixr 1 :++:
  69 infixr 1 .++.
  70
  71 class HAppendable l l' where
  72     type l :++: l'
  73     (.++.) :: l -> l' -> l :++: l'
  74
  75 instance HList l => HAppendable HNil l where
  76     type HNil :++: l = l
  77     _ .++. l = l
  78
  79 instance ( HList (l :++: l')
  80          , HAppendable l l'
  81          ) => HAppendable (HCons e l) l' where
  82     type HCons e l :++: l' = HCons e (l :++: l')
  83     (HCons e l) .++. l' = hCons e (l .++. l')
  84
  85 -- Applyable
  86 class Applyable f a where
  87     type Apply f a
  88     apply :: f -> a -> Apply f a
  89
  90 -- Applyable2
  91 class Applyable2 f a b where
  92     type Apply2 f a b
  93     apply2 :: f -> a -> b -> Apply2 f a b
  94
  95 -- Id
  96 data Id = Id
  97
  98 instance Applyable Id a where
  99     type Apply Id a = a
 100     apply _ a = a
 101
 102 -- ApplyHAppend
 103 data ApplyHAppend = ApplyHAppend
 104
 105 instance HAppendable a b => Applyable2 ApplyHAppend a b where
 106     type Apply2 ApplyHAppend a b = a :++: b
 107     apply2 _ a b = a .++. b
 108
 109 -- HFoldrable
 110 class HFoldrable f v l where
 111     type HFoldr f v l
 112     hFoldr :: f -> v -> l -> HFoldr f v l
 113
 114 instance HFoldrable f v HNil where
 115     type HFoldr f v HNil = v
 116     hFoldr _ v _ = v
 117
 118 instance ( HFoldrable f v l
 119          , Applyable2 f e (HFoldr f v l)
 120          ) => HFoldrable f v (HCons e l) where
 121     type HFoldr f v (HCons e l) = Apply2 f e (HFoldr f v l)
 122     hFoldr f v (HCons e l) = apply2 f e (hFoldr f v l)
 123
 124 -- HConcatable
 125 class HConcatable ls where
 126     type HConcat ls
 127     hConcat :: ls -> HConcat ls
 128
 129 instance HFoldrable ApplyHAppend HNil ls => HConcatable ls where
 130     type HConcat ls = HFoldr ApplyHAppend HNil ls
 131     hConcat ls = hFoldr ApplyHAppend hNil ls
 132
 133 -- HMappable
 134 class HMappable f l where
 135     type HMap f l
 136     hMap :: f -> l -> HMap f l
 137
 138 instance HMappable f HNil where
 139     type HMap f HNil = HNil
 140     hMap _ _ = hNil
 141
 142 instance ( Applyable f x
 143          , HMappable f xs
 144          , HList (HMap f xs)
 145          ) => HMappable f (HCons x xs) where
 146     type HMap f (HCons x xs) = HCons (Apply f x) (HMap f xs)
 147     hMap f (HCons x xs) = hCons (apply f x) (hMap f xs)