Purescript FRP sample

type Time = Number
type Color = String

-- any type that has a value, eg Number, is kind `*`
-- Behavior is a type constructor aka "Higher Kinded Type"
-- This is a function that takes an `a`, a type variable
-- and returns a `Behavior`
-- so it has kind `* -> *`

newtype Behavior a = Behavior { at :: Time -> a}
at :: forall a. Behavior a -> Time -> a

-- this function lets us reify a value `a` at time `t`
at (Behavior {at: bat}) t = bat t


-- in a pure language, we must carefully manage side-effects,
-- so the compiler knows where the program touches the outside world
-- Here, we define the type of a method that renders to an HTML canvas
class Renderable a where
    render :: forall eff. Context2D -> a -> Eff (canvas :: CANVAS | eff) Unit


newtype Rectangle = Rectangle { x :: Number, y :: Number, w :: Number
                              , h :: Number, c :: Color
                              }

-- let's make our rectangle renderable!
instance renderableRectangle :: Renderable Rectangle where
    render ctx (Rectangle {x,y,w,h,c}) = void do
        setFillStyle c ctx
        fillPath ctx $ rect ctx
            { x: x
            , y: y
            , w: w
            , h: h
            }

-- we can define a recursive function to make a list of renderable types
-- as renderable itself
instance renderableList :: Renderable a => Renderable (List a) where
    render ctx renderables = go renderables where
        go Nil = do
            pure unit
        go (b : bs) = void do
            render ctx b
            go bs

-- a curried version of the standard requestAnimationFrame (not shown)
foreign import requestAnimationFrame :: forall a eff.
    Window -> (Time -> Eff (dom :: DOM | eff) a) -> Eff (dom :: DOM | eff) Unit

-- simple loop that renders a behavior indefinitely
animationLoop :: forall e a. (Renderable a) =>
                 { w :: Window, ctx :: Context2D, width :: Number
                 , height :: Number, b :: Behavior a} -> Time
                   -> Eff (dom :: DOM, canvas :: CANVAS | e) Unit
animationLoop {w, ctx, width, height, b} t =
    let raf = requestAnimationFrame w
        loop t = do
            clearRect ctx { x: 0.0
                        , y: 0.0
                        , w: width
                        , h: height
                        }
            let world = b `at` t
            render ctx world
            raf loop
    in do raf loop

-- now let's run an animation. Dropped frames will not impact
-- rectangle location accuracy since behaviors are continuous
main = void $ unsafePartial do
    Just canvas <- getCanvasElementById "canvas"
    w <- window
    ctx <- getContext2D canvas
    width <- getCanvasWidth canvas
    height <- getCanvasHeight canvas
    let sample t = Rectangle { x: 0.01*t
                              , y: 250.0
                              , w: 10.0
                              , h: 300.0
                              , c: "red"
                              }

    let b = Behavior { at: sample }

    animationLoop {w:w, ctx:ctx, width:width, height:height, b:b} 0.0