GHC/Generics.hs

   1 {-
   2
   3 {-# OPTIONS_GHC -XNoImplicitPrelude -XTypeOperators #-}
   4
   5 module GHC.Generics where
   6
   7 default ()
   8
   9 data Unit = Unit
  10 #ifndef __HADDOCK__
  11 data (:+:) a b = Inl a | Inr b
  12 data (:*:) a b = a :*: b
  13 #endif
  14
  15 -}
  16
  17 {-# OPTIONS_GHC -XNoImplicitPrelude      #-}
  18 {-# OPTIONS_GHC -XEmptyDataDecls         #-}
  19 {-# OPTIONS_GHC -XMultiParamTypeClasses  #-}
  20 {-# OPTIONS_GHC -XTypeSynonymInstances   #-}
  21 {-# OPTIONS_GHC -XTypeOperators          #-}
  22 {-# OPTIONS_GHC -XKindSignatures         #-}
  23 {-# OPTIONS_GHC -XTypeFamilies           #-}
  24
  25 module GHC.Generics  (
  26   -- * Generic representation types
  27     V1, U1(..), Par1(..), Rec1(..), K1(..), M1(..)
  28   , (:+:)(..), (:*:)(..), (:.:)(..)
  29
  30   -- ** Synonyms for convenience
  31   , Rec0, Par0, R, P
  32   , D1, C1, S1, D, C, S
  33
  34   -- * Meta-information
  35   , Datatype(..), Constructor(..), Selector(..), NoSelector
  36   , Fixity(..), Associativity(..), Arity(..), prec
  37
  38   -- * Representation type families
  39   , Rep0, Rep1
  40
  41   -- * Representable type classes
  42   , Representable0(..), Representable1(..)
  43
  44 {-
  45   -- * Representations for base types
  46   , Rep0Char, Rep0Int, Rep0Float
  47   , Rep0Maybe, Rep1Maybe
  48   , Rep0List, Rep1List
  49 -}
  50   ) where
  51
  52 import {-# SOURCE #-} GHC.Types
  53
  54 --------------------------------------------------------------------------------
  55 -- Representation types
  56 --------------------------------------------------------------------------------
  57
  58 -- | Void: used for datatypes without constructors
  59 data V1 p
  60
  61 -- | Unit: used for constructors without arguments
  62 data U1 p = U1
  63
  64 -- | Used for marking occurrences of the parameter
  65 newtype Par1 p = Par1 { unPar1 :: p }
  66
  67
  68 -- | Recursive calls of kind * -> *
  69 newtype Rec1 f p = Rec1 { unRec1 :: f p }
  70
  71 -- | Constants, additional parameters and recursion of kind *
  72 newtype K1 i c p = K1 { unK1 :: c }
  73
  74 -- | Meta-information (constructor names, etc.)
  75 newtype M1 i c f p = M1 { unM1 :: f p }
  76
  77 -- | Sums: encode choice between constructors
  78 infixr 5 :+:
  79 data (:+:) f g p = L1 (f p) | R1 (g p)
  80
  81 -- | Products: encode multiple arguments to constructors
  82 infixr 6 :*:
  83 data (:*:) f g p = f p :*: g p
  84
  85 -- | Composition of functors
  86 infixr 7 :.:
  87 newtype (:.:) f g p = Comp1 { unComp1 :: f (g p) }
  88
  89 -- | Tag for K1: recursion (of kind *)
  90 data R
  91 -- | Tag for K1: parameters (other than the last)
  92 data P
  93
  94 -- | Type synonym for encoding recursion (of kind *)
  95 type Rec0  = K1 R
  96 -- | Type synonym for encoding parameters (other than the last)
  97 type Par0  = K1 P
  98
  99 -- | Tag for M1: datatype
 100 data D
 101 -- | Tag for M1: constructor
 102 data C
 103 -- | Tag for M1: record selector
 104 data S
 105
 106 -- | Type synonym for encoding meta-information for datatypes
 107 type D1 = M1 D
 108
 109 -- | Type synonym for encoding meta-information for constructors
 110 type C1 = M1 C
 111
 112 -- | Type synonym for encoding meta-information for record selectors
 113 type S1 = M1 S
 114
 115
 116 -- | Class for datatypes that represent datatypes
 117 class Datatype d where
 118   -- | The name of the datatype (unqualified)
 119   datatypeName :: t d (f :: * -> *) a -> [Char]
 120   -- | The fully-qualified name of the module where the type is declared
 121   moduleName   :: t d (f :: * -> *) a -> [Char]
 122
 123
 124 -- | Class for datatypes that represent records
 125 class Selector s where
 126   -- | The name of the selector
 127   selName :: t s (f :: * -> *) a -> [Char]
 128
 129 -- | Used for constructor fields without a name
 130 data NoSelector
 131
 132 instance Selector NoSelector where selName _ = ""
 133
 134 -- | Class for datatypes that represent data constructors
 135 class Constructor c where
 136   -- | The name of the constructor
 137   conName :: t c (f :: * -> *) a -> [Char]
 138
 139   -- | The fixity of the constructor
 140   conFixity :: t c (f :: * -> *) a -> Fixity
 141   conFixity _ = Prefix
 142
 143   -- | Marks if this constructor is a record
 144   conIsRecord :: t c (f :: * -> *) a -> Bool
 145   conIsRecord _ = False
 146
 147   -- | Marks if this constructor is a tuple,
 148   -- returning arity >=0 if so, <0 if not
 149   conIsTuple :: t c (f :: * -> *) a -> Arity
 150   conIsTuple _ = NoArity
 151
 152
 153 -- | Datatype to represent the arity of a tuple.
 154 data Arity = NoArity | Arity Int
 155 --  deriving (Eq, Show, Ord, Read)
 156 -- TODO: Add these instances to the Prelude
 157
 158 -- | Datatype to represent the fixity of a constructor. An infix
 159 -- | declaration directly corresponds to an application of 'Infix'.
 160 data Fixity = Prefix | Infix Associativity Int
 161 --  deriving (Eq, Show, Ord, Read)
 162 -- TODO: Add these instances to the Prelude
 163
 164 -- | Get the precedence of a fixity value.
 165 prec :: Fixity -> Int
 166 prec Prefix      = I# 10#
 167 prec (Infix _ n) = n
 168
 169 -- | Datatype to represent the associativy of a constructor
 170 data Associativity =  LeftAssociative
 171                    |  RightAssociative
 172                    |  NotAssociative
 173 --  deriving (Eq, Show, Ord, Read)
 174 -- TODO: Add these instances to the Prelude
 175
 176
 177 -- | Representable types of kind *
 178 class Representable0 a where
 179   -- | Representation type
 180   type Rep0 a :: * -> *
 181   -- | Convert from the datatype to its representation
 182   from0  :: a -> Rep0 a x
 183   -- | Convert from the representation to the datatype
 184   to0    :: Rep0 a x -> a
 185
 186 -- | Representable types of kind * -> *
 187 class Representable1 f rep where
 188   -- | Representation type
 189   type Rep1 f :: * -> *
 190   -- | Convert from the datatype to its representation
 191   from1  :: f a -> Rep1 f a
 192   -- | Convert from the representation to the datatype
 193   to1    :: Rep1 f a -> f a
 194
 195 --------------------------------------------------------------------------------
 196 -- Representation for base types
 197 --------------------------------------------------------------------------------
 198
 199 -- Representation types
 200 {-
 201 type Rep1Par1 = Par1
 202 instance Representable1 Par1 Rep1Par1 where
 203   from1 = id
 204   to1 = id
 205
 206 type Rep1Rec1 f = Rec1 f
 207 instance Representable1 (Rec1 f) (Rep1Rec1 f) where
 208   from1 = id
 209   to1 = id
 210 -}
 211 -- Kind *
 212
 213 {-
 214 type Rep0Char = Rec0 Char
 215 instance Representable0 Char Rep0Char where
 216   from0 = K1
 217   to0 = unK1
 218
 219 type Rep0Int = Rec0 Int
 220 instance Representable0 Int Rep0Int where
 221   from0 = K1
 222   to0 = unK1
 223
 224 type Rep0Float = Rec0 Float
 225 instance Representable0 Float Rep0Float where
 226   from0 = K1
 227   to0 = unK1
 228
 229 -- etc...
 230
 231 -- Kind * -> *
 232
 233 data Maybe_
 234 data Nothing_
 235 data Just_
 236
 237 instance Datatype Maybe_ where
 238   datatypeName _ = "Maybe"
 239   moduleName   _ = "Representation"
 240
 241 instance Constructor Nothing_ where
 242   conName _ = "Nothing"
 243
 244 instance Constructor Just_ where
 245   conName _ = "Just"
 246
 247 type Rep0Maybe a = D1 Maybe_ (C1 Nothing_ U1 :+: C1 Just_ (Par0 a))
 248 instance Representable0 (Maybe a) (Rep0Maybe a) where
 249   from0 Nothing  = M1 (L1 (M1 U1))
 250   from0 (Just x) = M1 (R1 (M1 (K1 x)))
 251   to0 (M1 (L1 (M1 U1)))     = Nothing
 252   to0 (M1 (R1 (M1 (K1 x)))) = Just x
 253
 254 type Rep1Maybe = D1 Maybe_ (C1 Nothing_ U1 :+: C1 Just_ Par1)
 255 instance Representable1 Maybe Rep1Maybe where
 256   from1 Nothing  = M1 (L1 (M1 U1))
 257   from1 (Just x) = M1 (R1 (M1 (Par1 x)))
 258   to1 (M1 (L1 (M1 U1)))       = Nothing
 259   to1 (M1 (R1 (M1 (Par1 x)))) = Just x
 260
 261
 262 data List__
 263 data Nil__
 264 data Cons__
 265
 266 instance Datatype [a] where
 267   datatypeName _ = "[]"
 268   moduleName   _ = "Data.List"
 269
 270 instance Constructor Nil__  where conName _ = "[]"
 271 instance Constructor Cons__ where
 272   conName   _ = ":"
 273   conFixity _ = Infix RightAssociative 5
 274
 275 type Rep0List a = D1 List__ ((C1 Nil__ U1) :+: (C1 Cons__ (Par0 a :*: Rec0 [a])))
 276 instance Representable0 [a] (Rep0List a) where
 277   from0 []    = M1 (L1 (M1 U1))
 278   from0 (h:t) = M1 (R1 (M1 (K1 h :*: K1 t)))
 279   to0 (M1 (L1 (M1 U1)))              = []
 280   to0 (M1 (R1 (M1 (K1 h :*: K1 t)))) = h : t
 281
 282 type Rep1List = D1 List__ ((C1 Nil__ U1) :+: (C1 Cons__ (Par1 :*: Rec1 [])))
 283 instance Representable1 [] Rep1List where
 284   from1 []    = M1 (L1 (M1 U1))
 285   from1 (h:t) = M1 (R1 (M1 (Par1 h :*: Rec1 t)))
 286   to1 (M1 (L1 (M1 U1)))                  = []
 287   to1 (M1 (R1 (M1 (Par1 h :*: Rec1 t)))) = h : t
 288
 289 -- etc...
 290 -}
 291