Matt's Software Blog

This is a proof of concept of an interactive collaborative development environment I built using  F# Interactive. The aim here is to explore different ideas for further development, not so much as to present an alternative to Visual Studio :) Source code here (zip).  ”Make it pink” code (txt), and Space Scene code (txt).

The video demonstrates a server and two clients collaborating on the same machine.

The way it works is that there are two different roles, the server (EchoServer) and the client (EchoClient). The role of the server is to act as repeater between the clients. When one client inputs source code the code is automatically sent to all the other clients. The server stores the code so when a new client joins it can be brought up to speed with all of the other clients.

This has the following advantages;

• Everyone is on the same page with the latest version of the software
• All developers work with the very latest source code
• The source code is continuously integrated in real time
• ‘Build’ breaks are noticed (and fixed) immediately

There are also a number of disadvantages;

• Cannot undo certain operations with side effects
• Code from the network is being downloaded and run on your machine
• The entire source code is a stored as single string

The reason I am playing with this is prepare for my next move into Domain Specific Modeling tools.

I’ve included the source code below. It is prototype code, so there are probably a few bugs in it, and as always feedback is greatly appreciated.

EchoServer

#light

open System
open System.IO
open System.Text
open System.Net
open System.Net.Sockets
open System.Threading
open System.Diagnostics
open System.Runtime.Serialization;
open System.Runtime.Serialization.Formatters.Binary;

// Connection settings
// Arguments IP address, and Port number
// e.g. 127.0.0.1 9050
let IPaddr = IPAddress.Loopback
let PortNo = 9050
let mutable filename = "log.txt"

// Helper functions
let wrapEvent (fBlock:unit->'a) =
    let event = new Event<'a>()
    let eventThread = new Thread(fun () ->  while true do event.Trigger((fBlock())))
    do eventThread.Start()
    event.Publish

let write s = printf "%s\n" s
let read() = System.Console.ReadLine()

// Networking functions
// types of messages, message error / disconnect = -1, connect = 0, command = 1
type Message = int * obj
type Client = string*(Message->unit)*(unit->Message)*NetworkStream

let mutable code = ""

let clients = new ResizeArray<Client>()

let getByteArray (o:obj) =
    use ms = new MemoryStream()
    let bf = new BinaryFormatter()
    bf.Serialize(ms,o)
    ms.ToArray()

let getObject (ba:byte array) =
    use ms = new MemoryStream(ba)
    let bf = new BinaryFormatter()
    ms.Position <- int64 0;
    bf.Deserialize(ms)

let sendVarData (stream:NetworkStream) (data:byte array) =
    let datasize = BitConverter.GetBytes(int32 data.Length)
    stream.Write(datasize, 0, 4)
    stream.Write(data, 0, data.Length)
    stream.Flush()

// There has to be a much better way? :)
let receiveVarData (stream:NetworkStream) =
    let mutable total = 0
    let mutable recv = 0
    let datasize = [|for n in 0..4 -> byte 0 |] // anyone have a better idea on how to do this?
    stream.Read(datasize, 0, 4) |> ignore
    let size = BitConverter.ToInt32(datasize,0)
    let mutable dataleft = size;
    let mutable data = [|for n in 0..size -> byte 0 |] // anyone have a better idea on how to do this?
    let mutable flag = false
    while total < size && not flag do
        recv <- stream.Read(data, total, dataleft)
        if (recv = 0) then
            data <- Encoding.ASCII.GetBytes("exit ")
            flag <- true
        total <- total + recv
        dataleft <- dataleft - recv
    data

let tcpListen ip portNo =
    try
        let tcp = new TcpListener(IPaddr, PortNo)
        tcp.Start()
        let conRecv = wrapEvent(fun () -> tcp.AcceptTcpClient())
        write "Awaiting connections"
        conRecv
    with
    | e -> write ("Unable to create TcpListener " + e.Message)
           exit 1

let server = tcpListen IPaddr PortNo

let clientHandler (client:TcpClient) =
    let ipaddr = client.Client.RemoteEndPoint.ToString()
    let ns = client.GetStream()
    let send(msg:Message) = try (sendVarData ns (getByteArray msg)) with | _ -> ()
    let recv()  =  try (getObject (receiveVarData ns)) :?> Message with | _ -> (-1,null)
    clients.Add(ipaddr, send, recv, ns)
    write ("New Connection from: " + ipaddr)
    let recvMsg = wrapEvent (fun () ->
        let (i,o) = recv()
        if i = -1 then
            clients.Remove(ipaddr,send,recv,ns) |> ignore
            write (ipaddr.ToString() + " has disconnected")
            Thread.CurrentThread.Abort()
        (i,o))
    recvMsg.Add(fun (msg) ->
        let (i,o) = msg
        match i with
        | 0 -> send(1,code + "\n;;") // start msg received - send everything
        | 1 ->
            write ((string o) + "\n")
            let str = "\n\n" + string o
            code <- code + str
            for (_,send,_,_)  in clients do send(1,o)  // echo command to all clients
        | _ -> write "Unhandled message received")

server.Add(fun (client) -> clientHandler client)

let readUrl (url:string) =
    try
        use sr = new StreamReader(WebRequest.Create(url).GetResponse().GetResponseStream())
        code <- sr.ReadToEnd()
        write ("Loaded " + url)
        // send uploaded code to clients
        for (_,send,_,_)  in clients do send(1,code)
    with
    | e -> write (sprintf "Unable to open url %s Error: %s" url e.Message )
let readFile filename =
    if File.Exists filename then
        try
           code <- File.ReadAllText(filename)
           write ("Loaded " + filename)
           // send uploaded code to clients
           for (_,send,_,_)  in clients do send(1,code)
        with
        | e -> write (sprintf "Unable to open file %s Error: %s" filename e.Message )
    else write ("File not found:" + filename)
let writeFile filename =
    try
        File.WriteAllText(filename, code)
        write ("Loading " + filename)
    with
    | e -> write (sprintf "Unable to write to file %s Error: %s"  filename  e.Message)
// Console
let inHandler cmd =
    match cmd with
    | "reset" ->  code <- ""; write "Reseting code"
    | (s:string) when (s.Split [|' '|]).[0] = "load" ->
        let ss = s.Split [|' '|]
        match ss.Length with
        | 1 -> readFile filename
        | 2 -> readFile ss.[1]
        | _ -> write "Incorrect usage of the load command"
    | (s:string) when (s.Split [|' '|]).[0] = "loadUrl" ->
        let ss = s.Split [|' '|]
        match ss.Length with
        | 2 -> readUrl ss.[1]
        | _ -> write "Incorrect usage of the loadUrl command"
    | (s:string) when (s.Split [|' '|]).[0] = "save" ->
        let ss = s.Split [|' '|]
        match ss.Length with
        | 1 -> writeFile filename
        | 2 -> writeFile ss.[1]
        | _ -> write "Incorrect usage of the save command"
    | "quit" -> exit 0
    | _ -> write "Command Not Found"

let cnslReadLine = wrapEvent(fun () -> System.Console.ReadLine())
cnslReadLine.Add(inHandler)

// Load up the space scene program
//readUrl "http://www.mattssoftwareblog.com/software/3DWPF/SpaceScene.txt"

EchoClient

#light

open System
open System.IO
open System.Text
open System.Net
open System.Net.Sockets
open System.Threading
open System.Diagnostics
open System.Runtime.Serialization;
open System.Runtime.Serialization.Formatters.Binary;
open System.Windows
open System.Windows.Markup
open System.Windows.Controls
open System.Xaml
open System.Xml

// Connection settings
// Arguments IP address, and Port number
// e.g. 127.0.0.1 9050
let IPaddr = IPAddress.Loopback
let PortNo = 9050
let FSharpDir = @"C:\Program Files (x86)\Microsoft F#\v4.0\"

// Helper functions
let wrapEvent (fBlock:unit->'a) =
    let event = new Event<'a>()
    let eventThread = new Thread(fun () ->  while true do event.Trigger((fBlock())))
    do eventThread.Start()
    event.Publish

let dispatch<'T when 'T :> Control> (f:'T -> Unit) (control:'T) =
    if (control.CheckAccess()) then f control
    else control.Dispatcher.Invoke(System.Windows.Threading.DispatcherPriority.Background, Action (fun () -> f(control))) |> ignore

type ProcessShell(psi:ProcessStartInfo)  =
    let proc = Process.Start(psi)
    let outEvent = wrapEvent (fun () -> proc.StandardOutput.ReadLine() + "\n")
    let errEvent = wrapEvent (fun () -> proc.StandardError.ReadLine() + "\n")
    member this.Output = outEvent
    member this.Error = errEvent
    member this.Input(s:string) =
        proc.StandardInput.WriteLine(s)
        proc.StandardInput.Flush()

let psi() file wd args =
    let tmp = new ProcessStartInfo()
    tmp.UseShellExecute <- false
    tmp.FileName <- file
    tmp.WorkingDirectory <- wd
    tmp.CreateNoWindow <- true
    tmp.RedirectStandardError <- true
    tmp.RedirectStandardInput <- true
    tmp.RedirectStandardOutput <- true
    tmp.Arguments <- args
    tmp

// types of messages, message error / disconnect = -1, connect = 0, command = 1
type Message = int * obj

let write (s:string) = System.Console.WriteLine(s)
let read() = System.Console.ReadLine()

let connect(ip:IPAddress, p:int) =
    let getByteArray (o:obj) =
        use ms = new MemoryStream()
        let bf = new BinaryFormatter()
        bf.Serialize(ms,o)
        ms.ToArray()

    let getObject (ba:byte array) =
        use ms = new MemoryStream(ba)
        let bf = new BinaryFormatter()
        ms.Position <- int64 0;
        bf.Deserialize(ms)

    let sendVarData (stream:NetworkStream) (data:byte array) =
        let datasize = BitConverter.GetBytes(int32 data.Length)
        stream.Write(datasize, 0, 4)
        stream.Write(data, 0, data.Length)
        stream.Flush()

    let receiveVarData (stream:NetworkStream) =
        let mutable total = 0
        let mutable recv = 0
        let datasize = [|for n in 0..4 -> byte 0 |]
        stream.Read(datasize, 0, 4) |> ignore
        let size = BitConverter.ToInt32(datasize,0)
        let mutable dataleft = size;
        let mutable data = [|for n in 0..size -> byte 0 |]
        let mutable flag = false
        while total < size && not flag do
            recv <- stream.Read(data, total, dataleft)
            if (recv = 0) then
                data <- Encoding.ASCII.GetBytes("exit ")
                flag <- true
            total <- total + recv
            dataleft <- dataleft - recv
        data

    let tc = new TcpClient()
    tc.Connect(ip,p)
    let ns = tc.GetStream()
    let send(msg:Message) = try (sendVarData ns (getByteArray msg)) with | _ -> ()
    let recv()  =  try (getObject (receiveVarData ns)) :?> Message with | _ -> (-1,null)
    (send, recv, ns)

// attempt connection
let (send:int*obj->unit , recv, stream) =
    try
        let tmp = connect(IPaddr, PortNo)
        tmp
    with
    | e ->  write (sprintf "Unable to connect to server %s, %i : %s" (IPaddr.ToString()) PortNo  e.Message)
            exit 1

let parseXAML (xaml : string) =
    use ms = new MemoryStream(Encoding.ASCII.GetBytes(xaml))
    ms.Position <- int64 0
    XamlReader.Load(ms)

let windowXaml =
    "<Window
        xmlns=\"http://schemas.microsoft.com/winfx/2006/xaml/presentation\"
        xmlns:x=\"http://schemas.microsoft.com/winfx/2006/xaml\"
        Title=\"EchoClient\" Height=\"400\" Width=\"512\">
    <Window.Resources>
        <Style x:Key=\"ConsoleTextBoxStyle\" TargetType=\"{x:Type TextBox}\">
            <Setter Property=\"TextBox.Background\" Value=\"Black\" />
            <Setter Property=\"TextBox.Foreground\" Value=\"White\" />
            <Setter Property=\"TextBox.VerticalScrollBarVisibility\" Value=\"Auto\" />
            <Setter Property=\"TextBox.TextWrapping\" Value=\"Wrap\" />
            <Setter Property=\"TextBox.FontFamily\" Value=\"Lucida Console\" />
            <Setter Property=\"TextBox.FontSize\" Value=\"10\" />
        </Style>
    </Window.Resources>
    <Grid>
        <Grid.RowDefinitions>
            <RowDefinition />
            <RowDefinition Height=\"4\"/>
            <RowDefinition Height=\"50\"/>
        </Grid.RowDefinitions>
        <TabControl Grid.Row=\"0\">
            <TabItem Header=\"Code\">
                <ScrollViewer>
                    <TextBox x:Name=\"code_TextBox\" IsReadOnly=\"True\" Style=\"{StaticResource ConsoleTextBoxStyle}\" />
                </ScrollViewer>
            </TabItem>
            <TabItem Header=\"Output\">
                <ScrollViewer>
                    <TextBox x:Name=\"output_TextBox\" IsReadOnly=\"True\" Style=\"{StaticResource ConsoleTextBoxStyle}\" />
                </ScrollViewer>
            </TabItem>
            <TabItem Header=\"Error\">
                <ScrollViewer>
                    <TextBox x:Name=\"error_TextBox\" IsReadOnly=\"True\" Style=\"{StaticResource ConsoleTextBoxStyle}\" />
                </ScrollViewer>
            </TabItem>
        </TabControl>
        <GridSplitter Grid.Row=\"1\" HorizontalAlignment=\"Stretch\" />
        <DockPanel Grid.Row=\"2\">
            <Button DockPanel.Dock=\"Right\" Name=\"send_Button\">_Send</Button>
            <ScrollViewer DockPanel.Dock=\"Left\" HorizontalScrollBarVisibility=\"Auto\" VerticalScrollBarVisibility=\"Auto\">
                <TextBox x:Name=\"inputCode_TextBox\" Style=\"{StaticResource ConsoleTextBoxStyle}\" AcceptsReturn=\"True\"/>
            </ScrollViewer>
        </DockPanel>
    </Grid>
</Window>"

let window = windowXaml |> parseXAML :?> Window
let send_Button = window.FindName("send_Button") :?> Button
let inputCode_TextBox = window.FindName("inputCode_TextBox") :?> TextBox
let code_TextBox = window.FindName("code_TextBox") :?> TextBox
let output_TextBox = window.FindName("output_TextBox") :?> TextBox
let error_TextBox = window.FindName("error_TextBox") :?> TextBox
send_Button.Click.Add(fun re -> send(1,inputCode_TextBox.Text + "\n;;"))

// Close stream and console when window is closed
window.Closed.Add(fun _ -> stream.Close(); exit 0)

// start up fsi
let fsi = ProcessShell((psi() (FSharpDir + "fsi.exe") FSharpDir ""))
// Console out
fsi.Output.Add(fun (s) -> write s)
fsi.Error.Add(fun (s) -> write s)
// GUI out
fsi.Output.Add(fun (s) -> output_TextBox |> dispatch (fun output_TextBox -> output_TextBox.Text <- output_TextBox.Text + s))
fsi.Error.Add(fun (s) -> error_TextBox |> dispatch (fun error_TextBox -> error_TextBox.Text <- error_TextBox.Text + s))

// Callback incomming messages
let msgRecvEvnt = wrapEvent(fun () ->
        let (i,o) = recv()
        if i = -1 then
            write "Disconnected from server"
            Thread.CurrentThread.Abort()
        (i,o))

// Console out, FSI in
msgRecvEvnt.Add(fun (i,o) -> match i with | 1 ->  fsi.Input (string o); write (string o) | _ -> write "Unrecognised message received")
// Gui out
msgRecvEvnt.Add(fun (i,o) ->
                    match i with
                    | 1 -> code_TextBox |> dispatch (fun code_TextBox -> code_TextBox.Text <- code_TextBox.Text + (string o))
                    | _ -> ())

// connect, and send IP address
send(0,IPaddr)

// run the application
let main() =
    let app = new Application()
    app.Run(window) |> ignore

[<STAThread>]
do main()