From b52b16e5dfec0c10b99cfbb90e4b7b39a37222a3 Mon Sep 17 00:00:00 2001 From: Danila Fedorin Date: Fri, 25 May 2018 10:40:35 -0700 Subject: [PATCH] Implement basic communications and messages. --- Go.elm | 45 +++++++++++++++++++++++++++++++++++++++++++++ Go/Decoders.elm | 36 ++++++++++++++++++++++++++++++++++++ Go/Game.elm | 32 ++++++++++++++++++++++++++++++++ Go/Types.elm | 31 +++++++++++++++++++++++++++++++ Go/Util.elm | 21 +++++++++++++++++++++ Go/Ws.elm | 12 ++++++++++++ 6 files changed, 177 insertions(+) create mode 100644 Go.elm create mode 100644 Go/Decoders.elm create mode 100644 Go/Game.elm create mode 100644 Go/Types.elm create mode 100644 Go/Util.elm create mode 100644 Go/Ws.elm diff --git a/Go.elm b/Go.elm new file mode 100644 index 0000000..d6f3cbd --- /dev/null +++ b/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 } diff --git a/Go/Decoders.elm b/Go/Decoders.elm new file mode 100644 index 0000000..ceb4800 --- /dev/null +++ b/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 diff --git a/Go/Game.elm b/Go/Game.elm new file mode 100644 index 0000000..1dc65f0 --- /dev/null +++ b/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 + diff --git a/Go/Types.elm b/Go/Types.elm new file mode 100644 index 0000000..9871d23 --- /dev/null +++ b/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 diff --git a/Go/Util.elm b/Go/Util.elm new file mode 100644 index 0000000..223e410 --- /dev/null +++ b/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) + _ -> [] diff --git a/Go/Ws.elm b/Go/Ws.elm new file mode 100644 index 0000000..480cae5 --- /dev/null +++ b/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)