Data/HList/Prelude.hs

   1 {-# LANGUAGE DeriveDataTypeable,
   2              FlexibleContexts,
   3              FlexibleInstances,
   4              MultiParamTypeClasses,
   5              TypeFamilies,
   6              TypeOperators,
   7              UndecidableInstances
   8   #-}
   9 module Data.HList.Prelude
  10     ( HList
  11
  12     , HNil(..)
  13     , hNil
  14
  15     , HCons(..)
  16     , hCons
  17
  18     , HExtendT(..)
  19     , HAppendT(..)
  20
  21     , ApplyT(..)
  22     , Apply2T(..)
  23
  24     , Id(..)
  25     , HAppendA(..)
  26
  27     , HFoldrT(..)
  28     , HConcatT(..)
  29     , HMapT(..)
  30
  31     , HAll
  32     , HLength
  33     )
  34     where
  35
  36 import Data.Typeable
  37 import Types.Data.Bool
  38 import Types.Data.Num hiding ((:*:))
  39
  40
  41 -- HList
  42 class HList l
  43
  44 -- HNil
  45 data HNil
  46     = HNil
  47       deriving (Show, Eq, Ord, Read, Typeable)
  48
  49 instance HList HNil
  50
  51 hNil :: HNil
  52 hNil = HNil
  53
  54 -- HCons
  55 data HCons e l
  56     = HCons e l
  57       deriving (Show, Eq, Ord, Read, Typeable)
  58
  59 instance HList l => HList (HCons e l)
  60
  61 hCons :: HList l => e -> l -> HCons e l
  62 hCons = HCons
  63
  64 -- HExtendT
  65 infixr 2 :*:
  66 infixr 2 .*.
  67
  68 class HExtendT e l where
  69     type e :*: l
  70     (.*.) :: e -> l -> e :*: l
  71
  72 instance HExtendT e HNil where
  73     type e :*: HNil = HCons e HNil
  74     e .*. nil = hCons e nil
  75
  76 instance HList l => HExtendT e (HCons e' l) where
  77     type e :*: HCons e' l = HCons e (HCons e' l)
  78     e .*. HCons e' l = hCons e (hCons e' l)
  79
  80 -- HAppendT
  81 infixr 1 :++:
  82 infixr 1 .++.
  83
  84 class HAppendT l l' where
  85     type l :++: l'
  86     (.++.) :: l -> l' -> l :++: l'
  87
  88 instance HList l => HAppendT HNil l where
  89     type HNil :++: l = l
  90     _ .++. l = l
  91
  92 instance ( HList (l :++: l')
  93          , HAppendT l l'
  94          ) => HAppendT (HCons e l) l' where
  95     type HCons e l :++: l' = HCons e (l :++: l')
  96     (HCons e l) .++. l' = hCons e (l .++. l')
  97
  98 -- ApplyT
  99 class ApplyT f a where
 100     type Apply f a
 101     apply :: f -> a -> Apply f a
 102     apply _ _ = undefined
 103
 104 -- Apply2T
 105 class Apply2T f a b where
 106     type Apply2 f a b
 107     apply2 :: f -> a -> b -> Apply2 f a b
 108     apply2 _ _ _ = undefined
 109
 110 -- Id
 111 data Id = Id
 112
 113 instance ApplyT Id a where
 114     type Apply Id a = a
 115     apply _ a = a
 116
 117 -- HAppendA
 118 data HAppendA = HAppendA
 119
 120 instance HAppendT a b => Apply2T HAppendA a b where
 121     type Apply2 HAppendA a b = a :++: b
 122     apply2 _ a b = a .++. b
 123
 124 -- HFoldrT
 125 class HFoldrT f v l where
 126     type HFoldr f v l
 127     hFoldr :: f -> v -> l -> HFoldr f v l
 128
 129 instance HFoldrT f v HNil where
 130     type HFoldr f v HNil = v
 131     hFoldr _ v _ = v
 132
 133 instance ( HFoldrT f v l
 134          , Apply2T f e (HFoldr f v l)
 135          ) => HFoldrT f v (HCons e l) where
 136     type HFoldr f v (HCons e l) = Apply2 f e (HFoldr f v l)
 137     hFoldr f v (HCons e l) = apply2 f e (hFoldr f v l)
 138
 139 -- HConcatT
 140 class HConcatT ls where
 141     type HConcat ls
 142     hConcat :: ls -> HConcat ls
 143
 144 instance HFoldrT HAppendA HNil ls => HConcatT ls where
 145     type HConcat ls = HFoldr HAppendA HNil ls
 146     hConcat ls = hFoldr HAppendA hNil ls
 147
 148 -- HMapT
 149 class HMapT f l where
 150     type HMap f l
 151     hMap :: f -> l -> HMap f l
 152
 153 instance HMapT f HNil where
 154     type HMap f HNil = HNil
 155     hMap _ _ = hNil
 156
 157 instance ( ApplyT f x
 158          , HMapT f xs
 159          , HList (HMap f xs)
 160          ) => HMapT f (HCons x xs) where
 161     type HMap f (HCons x xs) = HCons (Apply f x) (HMap f xs)
 162     hMap f (HCons x xs) = hCons (apply f x) (hMap f xs)
 163
 164 -- HAll
 165 type family HAll f l
 166 type instance HAll f HNil         = True
 167 type instance HAll f (HCons x xs) = If (Apply f x) (HAll f xs) False
 168
 169 -- HLength
 170 type family HLength l
 171 type instance HLength HNil        = D0
 172 type instance HLength (HCons e l) = Succ (HLength l)