gistfile1.hs

{-# LANGUAGE GADTs, RankNTypes, ImpredicativeTypes, GeneralizedNewtypeDeriving, KindSignatures #-}

module Main where


data UnitT        = Unit              deriving Show
data Sum aT bT    = Inl aT | Inr bT   deriving Show
data Prod aT bT   = Prod aT bT        deriving Show

data EP bT cT = EP {from :: (bT -> cT), to :: (cT -> bT)}
                    
data Rep tT where
  RUnit  ::                      Rep UnitT
  RInt   ::                      Rep Int
  RChar  ::                      Rep Char 
  RSum   :: Rep aT -> Rep bT ->  Rep (Sum aT bT)
  RProd  :: Rep aT -> Rep bT ->  Rep (Prod aT bT)
  RString ::                        Rep String
  RCon    ::  String -> Rep aT ->   Rep aT
  RType   ::  EP bT cT -> Rep cT ->  Rep bT

type RepAlgebra f  = (f UnitT
                        ,f Int
                        ,f Char
                        ,f String
                        ,forall a b. f a -> f b -> f (Sum a b)
                        ,forall a b. f a -> f b -> f (Prod a b)
                        ,forall a  . String -> f a -> f a
                        ,forall a b. EP a b -> f a -> f b
                        )
                        
foldRep :: RepAlgebra f -> Rep a -> f a
foldRep (unit, int, char, string, sum, prod, con, t) = f
  where f (RUnit)   = unit 
        f (RInt)    = int
        f (RChar)   = char
        f (RString) = string
        f (RSum ra rb)  = sum (f ra) (f rb)
        f (RProd ra rb) = (prod.Prod) (f ra) (f rb)
        f (RCon  l  ra) = con  l (f ra)
        f (RType ep ra) = t ep (f ra)
                        
{-
    GADT pattern match in non-rigid context for `RUnit'
      Probable solution: add a type signature for `f'
    In the pattern: RUnit
    In the definition of `f': f (RUnit) = unit
    In the definition of `foldRep':
        foldRep (unit, int, char, string, sum, prod, con, t)
                  = f
                  where
                      f (RUnit) = unit
                      f (RInt) = int
                      f (RChar) = char
                      f (RString) = string
                      f (RSum ra rb) = sum (f ra) (f rb)
                      f (RProd ra rb) = (prod . Prod) (f ra) (f rb)
                      f (RCon l ra) = con l (f ra)
                      f (RType ep ra) = t ep (f ra)
-}