functional-programming-snake/fsharp/solutions/Stream.fs

/// m08 stream: an event stream is a pure automaton (a Mealy machine).
/// There is no hidden state: whatever a stream "remembers" lives in the next stream it returns.
module Snake.Stream

/// Something that happens to the program: time passing (ms since start) or a key going down or up, and from
/// Module 13 a mouse click at `(x, y)` in canvas pixels. Every stream ignores the kinds of event it does not use.
type Event =
    | Time of int64
    | KeyDown of string
    | KeyUp of string
    | Click of int * int

type Stream<'a> = Stream of (Event -> 'a list * Stream<'a>)

let step (e: Event) (Stream f: Stream<'a>) : 'a list * Stream<'a> = f e

// Sources remember nothing, so the next stream is the same source again.
let keyDowns: Stream<string> =
    let rec source () =
        Stream(fun e ->
            match e with
            | KeyDown key -> [ key ], source ()
            | _ -> [], source ())

    source ()

let keyUps: Stream<string> =
    let rec source () =
        Stream(fun e ->
            match e with
            | KeyUp key -> [ key ], source ()
            | _ -> [], source ())

    source ()

// (m13, given in src/) The position of every Click event, in canvas pixels. Like the key sources it remembers nothing.
let clicks: Stream<int * int> =
    let rec source () =
        Stream(fun e ->
            match e with
            | Click(x, y) -> [ (x, y) ], source ()
            | _ -> [], source ())

    source ()

// `last` is the time of the previous Time event. Multiples of ms in (last, t] fire, ascending.
let rec private intervalFrom (ms: int64) (last: int64) : Stream<int64> =
    Stream(fun e ->
        match e with
        | Time t -> [ for k in last / ms + 1L .. t / ms -> k * ms ], intervalFrom ms t
        | _ -> [], intervalFrom ms last)

let interval (ms: int64) : Stream<int64> = intervalFrom ms 0L

// Each combinator steps the stream and wraps the *next* stream in the same combinator.
let rec map (f: 'a -> 'b) (s: Stream<'a>) : Stream<'b> =
    Stream(fun e ->
        let out, next = step e s
        List.map f out, map f next)

let rec filter (p: 'a -> bool) (s: Stream<'a>) : Stream<'a> =
    Stream(fun e ->
        let out, next = step e s
        List.filter p out, filter p next)

let rec choose (f: 'a -> 'b option) (s: Stream<'a>) : Stream<'b> =
    Stream(fun e ->
        let out, next = step e s
        List.choose f out, choose f next)

let rec merge (a: Stream<'a>) (b: Stream<'a>) : Stream<'a> =
    Stream(fun e ->
        let outA, nextA = step e a
        let outB, nextB = step e b
        outA @ outB, merge nextA nextB)

// The accumulator travels in the argument of the next scan, not in a variable.
// List.scan keeps z as its first element; drop it, we only emit new accumulators.
let rec scan (f: 'b -> 'a -> 'b) (z: 'b) (s: Stream<'a>) : Stream<'b> =
    Stream(fun e ->
        let out, next = step e s
        let accs = List.tail (List.scan f z out)
        accs, scan f (List.fold f z out) next)

// Only the first step is special; afterwards we are just `next`.
let startWith (v: 'a) (s: Stream<'a>) : Stream<'a> =
    Stream(fun e ->
        let out, next = step e s
        v :: out, next)

// (m10) `last` is the previous real time, `clock` the time the inner stream has been told. A long silence
// (a background tab) moves `clock` by at most `maxGap`, so the inner stream never has to catch up on minutes of beats.
let rec private clampFrom (maxGap: int64) (last: int64) (clock: int64) (s: Stream<'a>) : Stream<'a> =
    Stream(fun e ->
        match e with
        | Time t ->
            let now = clock + min (max (t - last) 0L) maxGap
            let out, next = step (Time now) s
            out, clampFrom maxGap t now next
        | KeyDown _
        | KeyUp _
        | Click _ ->
            let out, next = step e s
            out, clampFrom maxGap last clock next)

let clampTime (maxGap: int64) (s: Stream<'a>) : Stream<'a> = clampFrom maxGap 0L 0L s

// mapFold threads the stream through the events like fold, and keeps each step's outputs.
let run (events: Event list) (s: Stream<'a>) : 'a list =
    List.mapFold (fun stream e -> step e stream) s events |> fst |> List.concat