From 14f373d7efcd4057b83cc345a6be0812b0f4a71b Mon Sep 17 00:00:00 2001
From: Josh Freckleton <freckletonj@gmail.com>
Date: Sat, 21 Aug 2021 15:44:32 -0700
Subject: [PATCH] add instances for Profunctor and Traversing

add StateT to get types working (needs to be removed)

ah, we can't get rid of the newtype StateT

cleanup

use transformers StateT

use strict StateT

add backwards compatibility

backwards compatibility: Control.Applicative.pure

appease our forefathers

be satisfied!

light refactor
---
 dunai/dunai.cabal                             |  4 +-
 dunai/src/Data/MonadicStreamFunction.hs       |  1 +
 .../Instances/Profunctor.hs                   | 47 +++++++++++++++++++
 3 files changed, 51 insertions(+), 1 deletion(-)
 create mode 100644 dunai/src/Data/MonadicStreamFunction/Instances/Profunctor.hs

diff --git a/dunai/dunai.cabal b/dunai/dunai.cabal
index 3a3908a4..f683a482 100644
--- a/dunai/dunai.cabal
+++ b/dunai/dunai.cabal
@@ -70,6 +70,7 @@ library
                      Data.MonadicStreamFunction.Instances.ArrowLoop
                      Data.MonadicStreamFunction.Instances.ArrowPlus
                      Data.MonadicStreamFunction.Instances.Num
+                     Data.MonadicStreamFunction.Instances.Profunctor
                      Data.MonadicStreamFunction.Instances.VectorSpace
                      Data.MonadicStreamFunction.InternalCore
                      Data.MonadicStreamFunction.Parallel
@@ -82,7 +83,8 @@ library
                      transformers,
                      transformers-base,
                      MonadRandom,
-                     simple-affine-space
+                     simple-affine-space,
+                     profunctors
 
   hs-source-dirs:    src
   default-language:  Haskell2010
diff --git a/dunai/src/Data/MonadicStreamFunction.hs b/dunai/src/Data/MonadicStreamFunction.hs
index 702f0769..39e49332 100644
--- a/dunai/src/Data/MonadicStreamFunction.hs
+++ b/dunai/src/Data/MonadicStreamFunction.hs
@@ -57,3 +57,4 @@ import Data.MonadicStreamFunction.Util
 import Data.MonadicStreamFunction.Instances.ArrowChoice ()
 import Data.MonadicStreamFunction.Instances.ArrowLoop   ()
 import Data.MonadicStreamFunction.Instances.ArrowPlus   ()
+import Data.MonadicStreamFunction.Instances.Profunctor  ()
diff --git a/dunai/src/Data/MonadicStreamFunction/Instances/Profunctor.hs b/dunai/src/Data/MonadicStreamFunction/Instances/Profunctor.hs
new file mode 100644
index 00000000..2179452c
--- /dev/null
+++ b/dunai/src/Data/MonadicStreamFunction/Instances/Profunctor.hs
@@ -0,0 +1,47 @@
+{-# LANGUAGE CPP                 #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+{-# OPTIONS_GHC -ddump-simpl #-}
+
+-- | Instances of 'Profunctor' and 'Traversing' for Monadic Stream Functions ('MSF').
+--
+--   Import this module to include the (orphan) instances.
+module Data.MonadicStreamFunction.Instances.Profunctor where
+
+-- base
+import Control.Arrow
+
+#if !MIN_VERSION_base(4,8,0)
+import Data.Traversable (traverse)
+import Control.Applicative (Applicative)
+#endif
+
+-- profunctors
+import Data.Profunctor
+import Data.Profunctor.Traversing
+
+-- dunai
+import Data.MonadicStreamFunction.Core
+import Data.MonadicStreamFunction.InternalCore
+import Data.MonadicStreamFunction.Instances.ArrowChoice ()
+
+-- transformers
+import Control.Monad.Trans.State.Strict
+
+instance Monad m => Choice (MSF m) where
+  left' = left
+
+instance Monad m => Strong (MSF m) where
+  first' = first
+
+instance Monad m => Profunctor (MSF m) where
+  dimap l r p = arr l >>> p >>> arr r
+
+-- | This 'Traversing' instance will step the internal state of the 'MSF' once
+-- for every element of the input 'Traversable'.
+instance (Functor m, Applicative m, Monad m) => Traversing (MSF m) where
+  traverse' msf =
+    MSF $ \xs -> do
+      -- `StateT (MSF m a b) m a` is isomorphic to `a -> m (b, MSF m a b)`, and
+      -- `StateT`'s Applicative instance is needed for writing this traversal
+      (fb, msf') <- runStateT (traverse (StateT . flip unMSF) xs) msf
+      return (fb, traverse' msf')