fork download
copy 
  1. {-# LANGUAGE GADTs #-}
  2. {-# LANGUAGE DataKinds #-}
  3. {-# LANGUAGE TypeOperators #-}
  4. {-# LANGUAGE KindSignatures #-}
  5. {-# LANGUAGE TypeFamilies #-}
  6. {-# LANGUAGE RankNTypes #-}
  7. {-# LANGUAGE ConstraintKinds #-}
  8. {-# LANGUAGE MultiParamTypeClasses #-}
  9. {-# LANGUAGE FlexibleInstances #-}
  10. {-# LANGUAGE UndecidableSuperClasses #-}
  11. {-# LANGUAGE FlexibleContexts #-}
  12. {-# LANGUAGE TypeApplications #-}
  13.  
  14. import GHC.Exts (Constraint)
  15.  
  16. data Func (c :: (* -> * -> Constraint)) where
  17.   Func :: (forall a b. c a b => a -> b) -> Func c
  18.  
  19. class (c a, a ~ b) => BasicConstraint c a b
  20. instance (c a, a ~ b) => BasicConstraint c a b
  21.  
  22. numFunc = Func @(BasicConstraint Num)
  23. enumFunc = Func @(BasicConstraint Enum)
  24.  
  25. class (c a, t a ~ b) => NewtypeConstraint c t a b
  26. instance (c a, t a ~ b) => NewtypeConstraint c t a b
  27.  
  28. class EmptyConstraint a
  29. instance EmptyConstraint a
  30.  
  31. maybeFunc = Func @(NewtypeConstraint EmptyConstraint Maybe)
  32.  
  33. applyFunc :: Func c -> (forall a b. c a b => a -> b)
  34. applyFunc (Func f) = f
  35.  
  36. pairmap :: (c a a', c b b') => Func c -> (a, b) -> (a', b')
  37. pairmap f (x,y) = (applyFunc f x, applyFunc f y)
  38.  
  39. main = do
  40.   print $ pairmap (numFunc (+2)) (1::Int, 2::Float)
  41.   print $ pairmap (enumFunc succ) (1::Int, 'a')
  42.   print $ pairmap (maybeFunc Just) ('a', True)
  43.  
Success #stdin #stdout 0s 8388607KB
comments (?)
stdin
copy 
Standard input is empty
stdout
copy 
(3,4.0)
(2,'b')
(Just 'a',Just True)
https://ideone.com/wMMtMi
language:
Haskell (ghc 8.4.4)
created:
8 years ago
visibility:
public

Share or Embed source code

Discover > Sphere Engine API

The brand new service which powers Ideone!

Discover > IDE Widget

Widget for compiling and running the source code in a web browser!