MasseR
15e50322c4
Basically, the idea of `(oneBranch <> secondBranch)` instead of ``` do x <- foo case x of ... ```
50 lines
1.6 KiB
Haskell
50 lines
1.6 KiB
Haskell
{-# LANGUAGE OverloadedStrings #-}
|
|
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 T.Text) -> Maybe T.Text
|
|
renderF = \case
|
|
Empty -> Nothing
|
|
Step n x -> Just $ n <> T.pack (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 $ T.pack $ Text.printf "(%s, %s)" a b
|
|
Both (Just a) _ -> Just a
|
|
Both _ b -> b
|
|
Branch (Just a) (Just b) -> Just $ T.pack $ Text.printf "(%s || %s)" a b
|
|
-- I'm leaving this here. This would be technically more correct (showing
|
|
-- the empty branch, ie. the full if-then-else, but often we care about a
|
|
-- more simplistic `when` style structure
|
|
-- Branch (Just a) Nothing -> Just $ T.pack $ Text.printf "(%s || <skip>)" a
|
|
Branch (Just a) Nothing -> Just $ T.pack $ Text.printf "%s" a
|
|
Branch _ b -> b
|
|
Merge (Just a) (Just b) -> Just $ T.pack $ Text.printf "(%s, %s)" a b
|
|
Merge (Just a) _ -> Just a
|
|
Merge _ b -> b
|
|
Compose (Just a) (Just b) -> Just $ T.pack $ Text.printf "(%s, %s)" a b
|
|
Compose (Just a) _ -> Just a
|
|
Compose _ b -> b
|