module Generics.Deriving.Base (
#ifndef __UHC__
V1, U1(..), Par1(..), Rec1(..), K1(..), M1(..)
, (:+:)(..), (:*:)(..), (:.:)(..)
, Rec0, Par0, R, P
, D1, C1, S1, D, C, S
, Datatype(..), Constructor(..), Selector(..), NoSelector
, Fixity(..), Associativity(..), Arity(..), prec
, Representable0(..), Representable1(..)
,
#else
module UHC.Generics,
#endif
Rep0Char, Rep0Int, Rep0Float
, Rep0Maybe, Rep1Maybe
, Rep0List, Rep1List
) where
#ifdef __UHC__
import UHC.Generics
#endif
#ifndef __UHC__
#ifdef __UHC__
V1 :: * -> *
#endif
data V1 p
#ifdef __UHC__
U1 :: * -> *
#endif
data U1 p = U1
#ifdef __UHC__
Par1 :: * -> *
#endif
newtype Par1 p = Par1 { unPar1 :: p }
#ifdef __UHC__
Rec1 :: (* -> *) -> * -> *
#endif
newtype Rec1 f p = Rec1 { unRec1 :: f p }
#ifdef __UHC__
K1 :: * -> * -> * -> *
#endif
newtype K1 i c p = K1 { unK1 :: c }
#ifdef __UHC__
M1 :: * -> * -> (* -> *) -> * -> *
#endif
newtype M1 i c f p = M1 { unM1 :: f p }
infixr 5 :+:
#ifdef __UHC__
(:+:) :: (* -> *) -> (* -> *) -> * -> *
#endif
data (:+:) f g p = L1 { unL1 :: f p } | R1 { unR1 :: g p }
infixr 6 :*:
#ifdef __UHC__
(:*:) :: (* -> *) -> (* -> *) -> * -> *
#endif
data (:*:) f g p = f p :*: g p
infixr 7 :.:
#ifdef __UHC__
(:.:) :: (* -> *) -> (* -> *) -> * -> *
#endif
newtype (:.:) f g p = Comp1 { unComp1 :: f (g p) }
data R
data P
type Rec0 = K1 R
type Par0 = K1 P
data D
data C
data S
type D1 = M1 D
type C1 = M1 C
type S1 = M1 S
class Datatype d where
#ifdef __UHC__
datatypeName :: t d f a -> String
moduleName :: t d f a -> String
#else
datatypeName :: t d (f :: * -> *) a -> String
moduleName :: t d (f :: * -> *) a -> String
#endif
class Selector s where
#ifdef __UHC__
selName :: t s f a -> String
#else
selName :: t s (f :: * -> *) a -> String
#endif
data NoSelector
instance Selector NoSelector where selName _ = ""
class Constructor c where
#ifdef __UHC__
conName :: t c f a -> String
#else
conName :: t c (f :: * -> *) a -> String
#endif
#ifdef __UHC__
conFixity :: t c f a -> Fixity
#else
conFixity :: t c (f :: * -> *) a -> Fixity
#endif
conFixity = const Prefix
#ifdef __UHC__
conIsRecord :: t c f a -> Bool
#else
conIsRecord :: t c (f :: * -> *) a -> Bool
#endif
conIsRecord = const False
#ifdef __UHC__
conIsTuple :: t c f a -> Arity
#else
conIsTuple :: t c (f :: * -> *) a -> Arity
#endif
conIsTuple = const NoArity
data Arity = NoArity | Arity Int
deriving (Eq, Show, Ord, Read)
data Fixity = Prefix | Infix Associativity Int
deriving (Eq, Show, Ord, Read)
prec :: Fixity -> Int
prec Prefix = 10
prec (Infix _ n) = n
data Associativity = LeftAssociative
| RightAssociative
| NotAssociative
deriving (Eq, Show, Ord, Read)
class Representable0 a rep where
from0 :: a -> rep x
to0 :: rep x -> a
class Representable1 f rep where
from1 :: f a -> rep a
to1 :: rep a -> f a
#endif
type Rep0Char = Rec0 Char
instance Representable0 Char Rep0Char where
from0 = K1
to0 = unK1
type Rep0Int = Rec0 Int
instance Representable0 Int Rep0Int where
from0 = K1
to0 = unK1
type Rep0Float = Rec0 Float
instance Representable0 Float Rep0Float where
from0 = K1
to0 = unK1
data Maybe_
data Nothing_
data Just_
instance Datatype Maybe_ where
datatypeName _ = "Maybe"
moduleName _ = "Representation"
instance Constructor Nothing_ where
conName _ = "Nothing"
instance Constructor Just_ where
conName _ = "Just"
type Rep0Maybe a = D1 Maybe_ (C1 Nothing_ U1 :+: C1 Just_ (Par0 a))
instance Representable0 (Maybe a) (Rep0Maybe a) where
from0 Nothing = M1 (L1 (M1 U1))
from0 (Just x) = M1 (R1 (M1 (K1 x)))
to0 (M1 (L1 (M1 U1))) = Nothing
to0 (M1 (R1 (M1 (K1 x)))) = Just x
type Rep1Maybe = D1 Maybe_ (C1 Nothing_ U1 :+: C1 Just_ Par1)
instance Representable1 Maybe Rep1Maybe where
from1 Nothing = M1 (L1 (M1 U1))
from1 (Just x) = M1 (R1 (M1 (Par1 x)))
to1 (M1 (L1 (M1 U1))) = Nothing
to1 (M1 (R1 (M1 (Par1 x)))) = Just x
data List__
data Nil__
data Cons__
instance Datatype [a] where
datatypeName _ = "[]"
moduleName _ = "Data.List"
instance Constructor Nil__ where conName _ = "[]"
instance Constructor Cons__ where
conName _ = ":"
conFixity _ = Infix RightAssociative 5
type Rep0List a = D1 List__ ((C1 Nil__ U1) :+: (C1 Cons__ (Par0 a :*: Rec0 [a])))
instance Representable0 [a] (Rep0List a) where
from0 [] = M1 (L1 (M1 U1))
from0 (h:t) = M1 (R1 (M1 (K1 h :*: K1 t)))
to0 (M1 (L1 (M1 U1))) = []
to0 (M1 (R1 (M1 (K1 h :*: K1 t)))) = h : t
type Rep1List = D1 List__ ((C1 Nil__ U1) :+: (C1 Cons__ (Par1 :*: Rec1 [])))
instance Representable1 [] Rep1List where
from1 [] = M1 (L1 (M1 U1))
from1 (h:t) = M1 (R1 (M1 (Par1 h :*: Rec1 t)))
to1 (M1 (L1 (M1 U1))) = []
to1 (M1 (R1 (M1 (Par1 h :*: Rec1 t)))) = h : t