summaryrefslogtreecommitdiff
path: root/src/Control/Funflow/Diagram.hs
diff options
context:
space:
mode:
authornclarke <>2020-03-09 14:05:00 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2020-03-09 14:05:00 (GMT)
commit306e9a481ffcb94b92d059ce75c12663d23eb900 (patch)
tree2f2ab075c98d729f34cf1d7f38b847494a50593e /src/Control/Funflow/Diagram.hs
parent31eaf2c2a3b07a6553aef61572aa685426d9f5c2 (diff)
version 1.6.0HEAD1.6.0master
Diffstat (limited to 'src/Control/Funflow/Diagram.hs')
-rw-r--r--src/Control/Funflow/Diagram.hs12
1 files changed, 12 insertions, 0 deletions
diff --git a/src/Control/Funflow/Diagram.hs b/src/Control/Funflow/Diagram.hs
index 7305c9b..32a47c3 100644
--- a/src/Control/Funflow/Diagram.hs
+++ b/src/Control/Funflow/Diagram.hs
@@ -3,6 +3,9 @@
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE DerivingVia #-}
+{-# LANGUAGE RankNTypes #-}
+
-- | A Diagram is a representation of an arrow with labels.
-- No computation is actually performed by a diagram, it just carries
-- around a description.
@@ -13,6 +16,8 @@ module Control.Funflow.Diagram where
import Control.Arrow
import Control.Arrow.Free (ArrowError (..))
import Control.Category
+import qualified Data.Profunctor as P
+import qualified Data.Profunctor.Traversing as P
import Data.Proxy (Proxy (..))
import qualified Data.Text as T
import Prelude hiding (id, (.))
@@ -34,6 +39,9 @@ data Diagram ex a b where
Par :: Diagram ex a b -> Diagram ex c d -> Diagram ex (a,c) (b,d)
Fanin :: Diagram ex a c -> Diagram ex b c -> Diagram ex (Either a b) c
Try :: Diagram ex a b -> Diagram ex a (Either ex b)
+ Traverse :: Diagram ex a b -> Diagram ex (f a) (f b)
+ Wander :: (forall f. (Applicative f) => (a -> f b) -> s -> f t) -> Diagram ex a b -> Diagram ex s t
+ deriving (P.Profunctor, P.Strong, P.Choice) via P.WrappedArrow (Diagram ex)
instance Category (Diagram ex) where
id = Node emptyNodeProperties Proxy Proxy
@@ -53,6 +61,10 @@ instance ArrowChoice (Diagram ex) where
instance ArrowError ex (Diagram ex) where
try = Try
+instance P.Traversing (Diagram ex) where
+ traverse' = Traverse
+ wander = Wander
+
-- | Construct a labelled node
node :: forall arr a b ex. Arrow arr => arr a b -> [T.Text] -> (Diagram ex) a b
node _ lbls = Node props (Proxy :: Proxy a) (Proxy :: Proxy b)