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