45 lines
1.3 KiB
Haskell
45 lines
1.3 KiB
Haskell
module AFRP.Diagram where
|
|
import Data.Text (Text)
|
|
import qualified Text.Printf as Text
|
|
import qualified Data.Text as T
|
|
|
|
-- For rendering the arrows
|
|
data DiagramF f
|
|
= Empty
|
|
| Step Text f -- Named step
|
|
| Then f f -- >>>
|
|
| Both f f -- &&&
|
|
| Branch f f -- |||
|
|
| Merge f f -- <>
|
|
| Compose f f -- <*>
|
|
|
|
type DiagramAlgebra a = DiagramF a -> a
|
|
type DiagramC= forall a. DiagramAlgebra a -> a
|
|
|
|
combineDiagram :: (forall a. a -> a -> DiagramF a) -> DiagramC -> DiagramC -> DiagramC
|
|
combineDiagram constructor a b r = r (constructor (a r) (b r))
|
|
|
|
emptyDiagram :: DiagramC
|
|
emptyDiagram r = r Empty
|
|
|
|
|
|
renderF :: DiagramF (Maybe String) -> Maybe String
|
|
renderF = \case
|
|
Empty -> Nothing
|
|
Step n x -> Just $ T.unpack n <> maybe "" (Text.printf "( %s )") x
|
|
Then (Just a) (Just b) -> Just $ a <> " -> " <> b
|
|
Then (Just a) _ -> Just a
|
|
Then _ b -> b
|
|
Both (Just a) (Just b) -> Just $ Text.printf "(%s, %s)" a b
|
|
Both (Just a) _ -> Just a
|
|
Both _ b -> b
|
|
Branch (Just a) (Just b) -> Just $ Text.printf "(%s || %s)" a b
|
|
Branch (Just a) Nothing -> Just $ Text.printf "(%s || <skip>)" a
|
|
Branch _ b -> b
|
|
Merge (Just a) (Just b) -> Just $ Text.printf "(%s, %s)" a b
|
|
Merge (Just a) _ -> Just a
|
|
Merge _ b -> b
|
|
Compose (Just a) (Just b) -> Just $ Text.printf "(%s, %s)" a b
|
|
Compose (Just a) _ -> Just a
|
|
Compose _ b -> b
|