Haskell Flow Chart AST

Flow.hs

{-# LANGUAGE GADTs #-}
{-# OPTIONS -Wall #-}

module Flow where

data FlowT m a where
  Seq  :: m a -> FlowT m b -> FlowT m b
  Cond :: m Bool -> FlowT m a -> FlowT m a -> FlowT m a
  Term :: m a -> FlowT m a

runFlowT :: Monad m => FlowT m b -> m b
runFlowT (a `Seq` b) = a >> runFlowT b
runFlowT (Cond c y n) = do
  res <- c
  if res then runFlowT y
    else runFlowT n

runFlowT (Term a) = a

(>>>) :: m a -> FlowT m b -> FlowT m b
(>>>) = Seq

(>>?) :: m Bool -> (FlowT m a, FlowT m a) -> FlowT m a
a >>? (b, c) = Cond a b c

{-

a1     putStrLn "2"
           |
           v
a2     putStrLn "3" <-+
           |          |
           +----------+
-}

a1, a2 :: FlowT IO ()

a1 = putStrLn "2" >>> a2
a2 = putStrLn "3" >>> a2

{-

b1          putStrLn "aa" <----------+
                  |                  |
                  v                  |
b2     (== "aaaa") `fmap` getLine ---+
                  |                N
                  | Y
                  v
b3         putStrLn "Good"
                [END]
-}

b1, b2, b3 :: FlowT IO ()

b1 = putStrLn "aa" >>> b2
b2 = ( (== "aaaa") `fmap` getLine ) >>? (b3, b1)
b3 = Term (putStrLn "Good")

main :: IO ()
main = do
  runFlowT b1
  _ <- getLine
  runFlowT a1