Advertisement
Guest User

Untitled

a guest
May 21st, 2019
93
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 1.23 KB | None | 0 0
  1. {-# LANGUAGE
  2. AllowAmbiguousTypes,
  3. FlexibleContexts,
  4. FlexibleInstances,
  5. MultiParamTypeClasses,
  6. UndecidableInstances,
  7. TypeApplications
  8. #-}
  9.  
  10. import Control.Category hiding ((.), id)
  11. import Control.Arrow
  12. import Data.Kind (Type)
  13.  
  14. -- Turn (a -> (b -> (c -> ...))) into (a `r` (b `r` (c `r` ...)))
  15. class Arrowfy (r :: Type -> Type -> Type) x y where
  16. arrowfy :: x -> y
  17.  
  18. instance {-# OVERLAPPING #-} (Arrow r, Arrowfy r b z, y ~ r a z) => Arrowfy r (a -> b) y where
  19. arrowfy f = arr (arrowfy @r @b @z . f)
  20.  
  21. instance (x ~ y) => Arrowfy r x y where
  22. arrowfy = id
  23.  
  24. -- Dummy arrow
  25. data a :-> b = PA
  26.  
  27. instance Category (:->) where -- ...
  28. instance Arrow (:->) where -- ...
  29.  
  30. test :: Int :-> (Int :-> Int)
  31. test = arrowfy (+)
  32.  
  33. ---
  34.  
  35. -- Turn (a -> (b -> (c -> ... (... -> z) ...))) into ((a, (b, (c, ...))) -> z)
  36. class Uncurry x y z where
  37. uncurry_ :: x -> y -> z
  38.  
  39. instance {-# OVERLAPPING #-} (Uncurry (b -> c) yb z, y ~ (a, yb)) => Uncurry (a -> b -> c) y z where
  40. uncurry_ f (a, yb) = uncurry_ (f a) yb
  41.  
  42. instance (a ~ y, b ~ z) => Uncurry (a -> b) y z where
  43. uncurry_ = id
  44.  
  45. testUncurry :: (Int, Int) -> Int
  46. testUncurry = uncurry_ (+)
  47.  
  48. --
  49.  
  50. testUncurry2 :: (Int, (Int, (Int, Int))) :-> Int
  51. testUncurry2 = arr (uncurry_ (\a b c d -> a + b + c + d))
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement