fork download
  1. {-# LANGUAGE GADTs #-}
  2. {-# LANGUAGE DataKinds #-}
  3. {-# LANGUAGE KindSignatures #-}
  4. {-# LANGUAGE TypeFamilies #-}
  5. {-# LANGUAGE RankNTypes #-}
  6.  
  7. import GHC.Exts (Constraint)
  8.  
  9. class Function f where
  10. type Constraints f a :: Constraint
  11. type instance Constraints f a = ()
  12. type Result f a
  13. type instance Result f a = a
  14. applyFunc :: (Constraints f a) => f -> a -> Result f a
  15.  
  16. pairmap :: (Function f, Constraints f a, Constraints f b) => f -> (a, b) -> (Result f a, Result f b)
  17. pairmap f (x,y) = (applyFunc f x, applyFunc f y)
  18.  
  19. data NumFunc where
  20. NumFunc :: (forall a. Num a => a -> a) -> NumFunc
  21.  
  22. instance Function NumFunc where
  23. type Constraints NumFunc a = (Num a)
  24. applyFunc (NumFunc f) = f
  25.  
  26. data EnumFunc where
  27. EnumFunc :: (forall a. Enum a => a -> a) -> EnumFunc
  28.  
  29. instance Function EnumFunc where
  30. type Constraints EnumFunc a = (Enum a)
  31. applyFunc (EnumFunc f) = f
  32.  
  33. data MaybeFunc where
  34. MaybeFunc :: (forall a. a -> Maybe a) -> MaybeFunc
  35.  
  36. instance Function MaybeFunc where
  37. type Result MaybeFunc a = Maybe a
  38. applyFunc (MaybeFunc f) = f
  39.  
  40. y1 = pairmap (NumFunc (+2)) (1::Int, 2::Float)
  41. y2 = pairmap (EnumFunc succ) (1::Int, 'a')
  42. y3 = pairmap (MaybeFunc Just) ('a', True)
  43.  
  44. main = do
  45. print y1
  46. print y2
  47. print y3
  48.  
Success #stdin #stdout 0s 8388607KB
stdin
Standard input is empty
stdout
(3,4.0)
(2,'b')
(Just 'a',Just True)