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