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