Add Split

Author: garyb

bower.json

@@ -25,6 +25,7 @@
     "purescript-contravariant": "^3.0.0",
     "purescript-distributive": "^3.0.0",
     "purescript-either": "^3.0.0",
+    "purescript-exists": "^3.0.0",
     "purescript-tuples": "^4.0.0"
   }
 }

src/Data/Profunctor/Split.purs

@@ -0,0 +1,29 @@
+module Data.Profunctor.Split where
+
+import Prelude
+
+import Data.Exists (Exists, mkExists, runExists)
+import Data.Functor.Invariant (class Invariant, imap)
+import Data.Profunctor (class Profunctor)
+
+newtype Split f a b = Split (Exists (SplitF f a b))
+
+data SplitF f a b x = SplitF (a -> x) (x -> b) (f x)
+
+instance profunctorSplit :: Profunctor (Split f) where
+  dimap f g = unSplit \h i -> split (h <<< f) (g <<< i)
+
+split :: forall f a b x. (a -> x) -> (x -> b) -> f x -> Split f a b
+split f g fx = Split (mkExists (SplitF f g fx))
+
+unSplit :: forall f a b r. (forall x. (a -> x) -> (x -> b) -> f x -> r) -> Split f a b -> r
+unSplit f (Split e) = runExists (\(SplitF g h fx) -> f g h fx) e
+
+liftSplit :: forall f a. f a -> Split f a a
+liftSplit = split id id
+
+lowerSplit :: forall f a. Invariant f => Split f a a -> f a
+lowerSplit = unSplit (flip imap)
+
+hoistSplit :: forall f g a b. (f ~> g) -> Split f a b -> Split g a b
+hoistSplit nat = unSplit (\f g -> split f g <<< nat)