SHARE
TWEET

Untitled

a guest May 21st, 2019 64 Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  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))
RAW Paste Data
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy. OK, I Understand
 
Top