Implement basic communications and messages.

Go.elm

@@ -0,0 +1,45 @@
+import Go.Types exposing (..)
+import Go.Game exposing (verify)
+import Go.Decoders exposing (decodeUpdatestring)
+import Go.Ws exposing (..)
+import WebSocket
+import Html exposing (Html, div, text)
+
+init : Flags -> (Model, Cmd Msg)
+init flags = (Model 
+    (if flags.black then Black else White)
+    flags.url
+    flags.id
+    flags.size
+    Nothing
+    Nothing
+    [], Cmd.none)
+
+initDummy : (Model, Cmd Msg)
+initDummy = (Model
+    Black
+    "ws://localhost:3000"
+    1
+    9
+    Nothing
+    Nothing
+    [], Cmd.none)
+
+view : Model -> Html Msg
+view m = div [] [ text (toString m.currentColor) ]
+
+update : Msg -> Model -> (Model, Cmd Msg)
+update msg model = case msg of
+    Place c -> case verify c model of
+        Nothing -> ( { model | error = Just "Can't place piece" }, Cmd.none)
+        Just c -> ( { model | board = c::model.board }, Cmd.none)
+    Update s -> case decodeUpdatestring s of
+        Ok (c, xs) -> ( { model | board = xs, currentColor = Just c }, Cmd.none)
+        Err s -> ( { model | error = Just "Can't parse server response" }, Cmd.none)
+    DismissError -> ({ model | error = Nothing }, Cmd.none)
+
+subscriptions : Model -> Sub Msg
+subscriptions m = 
+    WebSocket.listen m.sessionUrl Update
+
+main = Html.program { init = initDummy, update = update, subscriptions = subscriptions, view = view }

Go/Decoders.elm

@@ -0,0 +1,36 @@
+module Go.Decoders exposing (..)
+import Go.Types exposing (..)
+import Json.Decode as Decode
+import Json.Decode.Pipeline exposing (decode, required)
+
+pair : a -> b -> (a, b)
+pair a1 a2 = (a1, a2)
+
+decodeIndex : Decode.Decoder Index
+decodeIndex = decode pair
+    |> required "x" Decode.int
+    |> required "y" Decode.int
+
+decodeColor : Decode.Decoder Color
+decodeColor = 
+    let
+        tryDecode : String -> Decode.Decoder Color
+        tryDecode s = case s of
+            "White" -> Decode.succeed White
+            "Black" -> Decode.succeed Black
+            _ -> Decode.fail "Invalid color"
+    in
+        Decode.andThen tryDecode Decode.string 
+
+decodeCell : Decode.Decoder Cell
+decodeCell = decode pair
+    |> required "index" decodeIndex
+    |> required "color" decodeColor
+
+decodeUpdate : Decode.Decoder Update
+decodeUpdate = decode pair
+    |> required "turn" decodeColor
+    |> required "board" (Decode.list decodeCell)
+
+decodeUpdatestring : String -> Result String Update
+decodeUpdatestring = Decode.decodeString decodeUpdate

Go/Game.elm

@@ -0,0 +1,32 @@
+module Go.Game exposing (verify)
+import Go.Types exposing (..)
+import Go.Util exposing (lookup)
+
+-- Make sure it's our turn to play.
+verifyTurn : Model -> Cell -> Maybe Cell
+verifyTurn model c = if 
+    (Just model.sessionColor) == model.currentColor then 
+        Just c 
+    else
+        Nothing
+
+-- Make sure there's not already a piece where we're going.
+verifyClear : Model -> Cell -> Maybe Cell
+verifyClear model (indx, c) = case lookup indx model.board of
+    Just _ -> Nothing
+    Nothing -> Just (indx, c)
+
+-- Make sure cell is in range of the board.
+verifyBounds : Model -> Cell -> Maybe Cell
+verifyBounds model ((x, y), c) = if x >= 0 && x < model.sessionSize && y >= 0 && y < model.sessionSize
+    then Just ((x, y), c)
+    else Nothing
+
+-- Verify a cell placemenet using a list of verification functions.
+verifyAll : Cell -> List (Model -> Cell -> Maybe Cell) -> Model -> Maybe Cell
+verifyAll cell funcs model = List.foldl (\a b -> Maybe.andThen (a model) b) (Just cell) funcs
+
+-- Make sure that a move to the given cell can be made.
+verify : Cell -> Model -> Maybe Cell
+verify cell model = verifyAll cell [verifyBounds, verifyTurn, verifyClear] model
+

Go/Types.elm

@@ -0,0 +1,31 @@
+module Go.Types exposing (..)
+import Time exposing (Time)
+
+type Color = White | Black
+type alias Index = (Int, Int)
+type alias Cell = (Index, Color)
+type alias Board = List Cell
+type alias Update = (Color, List Cell)
+
+type alias Model = 
+    { sessionColor : Color
+    , sessionUrl : String
+    , sessionId : Int
+    , sessionSize : Int
+
+    , error : Maybe String
+    , currentColor : Maybe Color
+    , board : Board
+    }
+
+type alias Flags =
+    { black : Bool
+    , url : String
+    , id : Int
+    , size : Int
+    }
+
+type Msg =
+      Place Cell
+    | Update String
+    | DismissError

Go/Util.elm

@@ -0,0 +1,21 @@
+module Go.Util exposing (..)
+import Go.Types exposing (..)
+
+-- Search for a value in a list of key-value pairs.
+lookup : a -> List (a, b) -> Maybe b
+lookup val list = Maybe.map Tuple.second (List.head (List.filter (\(a, _) -> a == val) list))
+
+-- Computes all possible indices on a board of size n.
+allIndices : Int -> List Index
+allIndices n = 
+    let
+        vals = List.range 0 (n - 1)
+        pairs = \xs i -> List.map (\x -> (i, x)) xs
+    in
+        List.concatMap (pairs vals) vals
+
+
+zip : List a -> List b -> List (a, b)
+zip xs ys = case (xs, ys) of
+    (x::xb, y::yb) -> (x, y) :: (zip xb yb)
+    _ -> []

Go/Ws.elm

@@ -0,0 +1,12 @@
+module Go.Ws exposing (..)
+import Go.Types exposing (..)
+import WebSocket
+
+encodeCell : Cell -> String
+encodeCell ((x, y), c) = "place "
+    ++ (toString x) ++ " "
+    ++ (toString y) ++ " "
+    ++ (toString c)
+
+sendMove : Model -> Cell -> Cmd Msg
+sendMove m c = WebSocket.send m.sessionUrl (encodeCell c)