diff options
author | nclarke <> | 2020-03-09 14:05:00 (GMT) |
---|---|---|
committer | hdiff <hdiff@hdiff.luite.com> | 2020-03-09 14:05:00 (GMT) |
commit | 306e9a481ffcb94b92d059ce75c12663d23eb900 (patch) | |
tree | 2f2ab075c98d729f34cf1d7f38b847494a50593e /src/Control/Funflow/Diagram.hs | |
parent | 31eaf2c2a3b07a6553aef61572aa685426d9f5c2 (diff) |
Diffstat (limited to 'src/Control/Funflow/Diagram.hs')
-rw-r--r-- | src/Control/Funflow/Diagram.hs | 12 |
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) |