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