Implement basic communications and messages.

This commit is contained in:
2018-05-25 10:40:35 -07:00
commit b52b16e5df
6 changed files with 177 additions and 0 deletions

36
Go/Decoders.elm Normal file
View File

@@ -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

32
Go/Game.elm Normal file
View File

@@ -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

31
Go/Types.elm Normal file
View File

@@ -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

21
Go/Util.elm Normal file
View File

@@ -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)
_ -> []

12
Go/Ws.elm Normal file
View File

@@ -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)