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