{-# OPTIONS -farrows #-}

module ArrowTest where

import Data.Graph.Inductive
--AFRP stuff is from Yampa
import AFRP
import AFRPUtilities

type Delayed = Bool

data MyNode f = MyNode String (Func f)

data Func f
    = Input
    | Func f Delayed

rawNodes = [
    (1, MyNode "A" Input),
    (2, MyNode "B" Input),
    (3, MyNode "C" (Func min True)),
    (4, MyNode "D" (Func (-) False)),
    (5, MyNode "E" (Func (+) True)),
    (6, MyNode "F" (Func max False))
    ]

rawEdges = [
    (1,3,"e1"),
    (1,5,"e2"),
    (2,4,"e3"),
    (3,4,"e4"),
    (4,3,"e5"),
    (4,6,"e6"),
    (5,6,"e7"),
    (6,5,"e8")
    ]

rawGraph :: Gr (MyNode (Int -> Int -> Int)) String
rawGraph = mkGraph rawNodes rawEdges


compiledGraph = proc (a,b) -> do
    d <- scc1 -< (a,b)
    f <- scc2 -< (a,d)
    returnA -< f

scc1 = proc (a,b) -> do
    rec
        c <- sfC -< (a,d)
        d <- sfD -< (b,c)
    returnA -< d

scc2 = proc (a,d) -> do
    rec
        e <- sfE -< (a,f)
        f <- sfF -< (d,e)
    returnA -< f

-- The graphs may be cyclic so delays are introduced such that the resulting
-- function is not infinitely recursive.

-- fby ('followed by'), which comes from Yampa, is used to introduce the delay

sfC = 0 `fby` mkArrow min
sfD = arr mkArrow (-)
sfE = 0 `fby` mkArrow (+)
sfF = arr mkArrow max

mkArrow = arr . uncurry