Create a gist now

Instantly share code, notes, and snippets.

What would you like to do?
Follow up to the example of implementing "enterprise" tic-tac-toe in a functional way.
(*
enterprise-tic-tac-toe-2.fsx
Follow up to the example of implementing "enterprise" tic-tac-toe in a functional way.
* Added true capability based security.
Related blog post: http://fsharpforfunandprofit.com/posts/enterprise-tic-tac-toe-2/
*)
open System
// -----------------------------------------------------------
// TicTacToeDomain
// -----------------------------------------------------------
module TicTacToeDomain =
type HorizPosition = Left | HCenter | Right
type VertPosition = Top | VCenter | Bottom
type CellPosition = HorizPosition * VertPosition
type Player = PlayerO | PlayerX
type CellState =
| Played of Player
| Empty
type Cell = {
pos : CellPosition
state : CellState
}
/// Everything the UI needs to know to display the board
type DisplayInfo = {
cells : Cell list
}
/// The capability to make a move at a particular location.
/// The gamestate, player and position are already "baked" into the function.
type MoveCapability =
unit -> MoveResult
/// A capability along with the position the capability is associated with.
/// This allows the UI to show information so that the user
/// can pick a particular capability to exercise.
and NextMoveInfo = {
// the pos is for UI information only
// the actual pos is baked into the cap.
posToPlay : CellPosition
capability : MoveCapability }
/// The result of a move. It includes:
/// * The information on the current board state.
/// * The capabilities for the next move, if any.
and MoveResult =
| PlayerXToMove of DisplayInfo * NextMoveInfo list
| PlayerOToMove of DisplayInfo * NextMoveInfo list
| GameWon of DisplayInfo * Player
| GameTied of DisplayInfo
// Only the newGame function is exported from the implementation
// all other functions come from the results of the previous move
type TicTacToeAPI =
{
newGame : MoveCapability
}
// -----------------------------------------------------------
// TicTacToeImplementation
// -----------------------------------------------------------
module TicTacToeImplementation =
open TicTacToeDomain
/// private implementation of game state
type GameState = {
cells : Cell list
}
/// the list of all horizontal positions
let allHorizPositions = [Left; HCenter; Right]
/// the list of all horizontal positions
let allVertPositions = [Top; VCenter; Bottom]
/// A type to store the list of cell positions in a line
type Line = Line of CellPosition list
/// a list of the eight lines to check for 3 in a row
let linesToCheck =
let mkHLine v = Line [for h in allHorizPositions do yield (h,v)]
let hLines= [for v in allVertPositions do yield mkHLine v]
let mkVLine h = Line [for v in allVertPositions do yield (h,v)]
let vLines = [for h in allHorizPositions do yield mkVLine h]
let diagonalLine1 = Line [Left,Top; HCenter,VCenter; Right,Bottom]
let diagonalLine2 = Line [Left,Bottom; HCenter,VCenter; Right,Top]
// return all the lines to check
[
yield! hLines
yield! vLines
yield diagonalLine1
yield diagonalLine2
]
/// get the DisplayInfo from the gameState
let getDisplayInfo gameState =
{DisplayInfo.cells = gameState.cells}
/// get the cell corresponding to the cell position
let getCell gameState posToFind =
gameState.cells
|> List.find (fun cell -> cell.pos = posToFind)
/// update a particular cell in the GameState
/// and return a new GameState
let private updateCell newCell gameState =
// create a helper function
let substituteNewCell oldCell =
if oldCell.pos = newCell.pos then
newCell
else
oldCell
// get a copy of the cells, with the new cell swapped in
let newCells = gameState.cells |> List.map substituteNewCell
// return a new game state with the new cells
{gameState with cells = newCells }
/// Return true if the game was won by the specified player
let private isGameWonBy player gameState =
// helper to check if a cell was played by a particular player
let cellWasPlayedBy playerToCompare cell =
match cell.state with
| Played player -> player = playerToCompare
| Empty -> false
// helper to see if every cell in the Line has been played by the same player
let lineIsAllSamePlayer player (Line cellPosList) =
cellPosList
|> List.map (getCell gameState)
|> List.forall (cellWasPlayedBy player)
linesToCheck
|> List.exists (lineIsAllSamePlayer player)
/// Return true if all cells have been played
let private isGameTied gameState =
// helper to check if a cell was played by any player
let cellWasPlayed cell =
match cell.state with
| Played _ -> true
| Empty -> false
gameState.cells
|> List.forall cellWasPlayed
/// determine the remaining moves
let private remainingMoves gameState =
// helper to return Some if a cell is playable
let playableCell cell =
match cell.state with
| Played player -> None
| Empty -> Some cell.pos
gameState.cells
|> List.choose playableCell
// return the other player
let otherPlayer player =
match player with
| PlayerX -> PlayerO
| PlayerO -> PlayerX
// return the move result case for a player
let moveResultFor player displayInfo nextMoves =
match player with
| PlayerX -> PlayerXToMove (displayInfo, nextMoves)
| PlayerO -> PlayerOToMove (displayInfo, nextMoves)
// given a function, a player & a gameState & a position,
// create a NextMoveInfo with the capability to call the function
let makeNextMoveInfo f player gameState cellPos =
// the capability has the player & cellPos & gameState baked in
let capability() = f player cellPos gameState
{posToPlay=cellPos; capability=capability}
// given a function, a player & a gameState & a list of positions,
// create a list of NextMoveInfos wrapped in a MoveResult
let makeMoveResultWithCapabilities f player gameState cellPosList =
let displayInfo = getDisplayInfo gameState
cellPosList
|> List.map (makeNextMoveInfo f player gameState)
|> moveResultFor player displayInfo
// player X or O makes a move
let rec playerMove player cellPos gameState =
let newCell = {pos = cellPos; state = Played player}
let newGameState = gameState |> updateCell newCell
let displayInfo = getDisplayInfo newGameState
if newGameState |> isGameWonBy player then
// return the move result
GameWon (displayInfo, player)
elif newGameState |> isGameTied then
// return the move result
GameTied displayInfo
else
let otherPlayer = otherPlayer player
let moveResult =
newGameState
|> remainingMoves
|> makeMoveResultWithCapabilities playerMove otherPlayer newGameState
moveResult
/// create the state of a new game
let newGame() =
// allPositions is the cross-product of the positions
let allPositions = [
for h in allHorizPositions do
for v in allVertPositions do
yield (h,v)
]
// all cells are empty initially
let emptyCells =
allPositions
|> List.map (fun pos -> {pos = pos; state = Empty})
// create initial game state
let gameState = { cells=emptyCells }
// initial of valid moves for player X is all positions
let moveResult =
allPositions
|> makeMoveResultWithCapabilities playerMove PlayerX gameState
// return new game
moveResult
/// export the API to the application
let api = {
newGame = newGame
}
// -----------------------------------------------------------
// ConsoleUi
// -----------------------------------------------------------
/// Console based user interface
module ConsoleUi =
open TicTacToeDomain
/// Track the UI state
type UserAction<'a> =
| ContinuePlay of 'a
| ExitGame
/// Print each available move on the console
let displayNextMoves nextMoves =
nextMoves
|> List.iteri (fun i moveInfo ->
printfn "%i) %A" i moveInfo.posToPlay)
/// Get the move corresponding to the
/// index selected by the user
let getCapability selectedIndex nextMoves =
if selectedIndex < List.length nextMoves then
let move = List.nth nextMoves selectedIndex
Some move.capability
else
None
/// Given that the user has not quit, attempt to parse
/// the input text into a index and then find the move
/// corresponding to that index
let processMoveIndex inputStr availableMoves processInputAgain =
match Int32.TryParse inputStr with
// TryParse will output a tuple (parsed?,int)
| true,inputIndex ->
// parsed ok, now try to find the corresponding move
match getCapability inputIndex availableMoves with
| Some capability ->
// corresponding move found, so make a move
let moveResult = capability()
ContinuePlay moveResult // return it
| None ->
// no corresponding move found
printfn "...No move found for inputIndex %i. Try again" inputIndex
// try again
processInputAgain()
| false, _ ->
// int was not parsed
printfn "...Please enter an int corresponding to a displayed move."
// try again
processInputAgain()
/// Ask the user for input. Process the string entered as
/// a move index or a "quit" command
let rec processInput availableCapabilities =
// helper that calls this function again with exactly
// the same parameters
let processInputAgain() =
processInput availableCapabilities
printfn "Enter an int corresponding to a displayed move or q to quit:"
let inputStr = Console.ReadLine()
if inputStr = "q" then
ExitGame
else
processMoveIndex inputStr availableCapabilities processInputAgain
/// Display the cells on the console in a grid
let displayCells displayInfo =
let cells = displayInfo.cells
let cellToStr cell =
match cell.state with
| Empty -> "-"
| Played player ->
match player with
| PlayerO -> "O"
| PlayerX -> "X"
let printCells cells =
cells
|> List.map cellToStr
|> List.reduce (fun s1 s2 -> s1 + "|" + s2)
|> printfn "|%s|"
let topCells =
cells |> List.filter (fun cell -> snd cell.pos = Top)
let centerCells =
cells |> List.filter (fun cell -> snd cell.pos = VCenter)
let bottomCells =
cells |> List.filter (fun cell -> snd cell.pos = Bottom)
printCells topCells
printCells centerCells
printCells bottomCells
printfn "" // add some space
/// After each game is finished,
/// ask whether to play again.
let rec askToPlayAgain api =
printfn "Would you like to play again (y/n)?"
match Console.ReadLine() with
| "y" ->
ContinuePlay (api.newGame())
| "n" ->
ExitGame
| _ -> askToPlayAgain api
/// The main game loop, repeated
/// for each user input
let rec gameLoop api userAction =
printfn "\n------------------------------\n" // a separator between moves
match userAction with
| ExitGame ->
printfn "Exiting game."
| ContinuePlay moveResult ->
// handle each case of the result
match moveResult with
| GameTied displayInfo ->
displayInfo |> displayCells
printfn "GAME OVER - Tie"
printfn ""
let nextUserAction = askToPlayAgain api
gameLoop api nextUserAction
| GameWon (displayInfo,player) ->
displayInfo |> displayCells
printfn "GAME WON by %A" player
printfn ""
let nextUserAction = askToPlayAgain api
gameLoop api nextUserAction
| PlayerOToMove (displayInfo,nextMoves) ->
displayInfo |> displayCells
printfn "Player O to move"
displayNextMoves nextMoves
let newResult = processInput nextMoves
gameLoop api newResult
| PlayerXToMove (displayInfo,nextMoves) ->
displayInfo |> displayCells
printfn "Player X to move"
displayNextMoves nextMoves
let newResult = processInput nextMoves
gameLoop api newResult
/// start the game with the given API
let startGame api =
let userAction = ContinuePlay (api.newGame())
gameLoop api userAction
// -----------------------------------------------------------
// Logging
// -----------------------------------------------------------
module Logger =
open TicTacToeDomain
/// Transform a MoveCapability into a logged version
let transformCapability transformMR player cellPos (cap:MoveCapability) :MoveCapability =
// create a new capability that logs the player & cellPos when run
let newCap() =
printfn "LOGINFO: %A played %A" player cellPos
let moveResult = cap()
transformMR moveResult
newCap
/// Transform a NextMove into a logged version
let transformNextMove transformMR player (move:NextMoveInfo) :NextMoveInfo =
let cellPos = move.posToPlay
let cap = move.capability
{move with capability = transformCapability transformMR player cellPos cap}
/// Transform a MoveResult into a logged version
let rec transformMoveResult (moveResult:MoveResult) :MoveResult =
let tmr = transformMoveResult // abbreviate!
match moveResult with
| PlayerXToMove (display,nextMoves) ->
let nextMoves' = nextMoves |> List.map (transformNextMove tmr PlayerX)
PlayerXToMove (display,nextMoves')
| PlayerOToMove (display,nextMoves) ->
let nextMoves' = nextMoves |> List.map (transformNextMove tmr PlayerO)
PlayerOToMove (display,nextMoves')
| GameWon (display,player) ->
printfn "LOGINFO: Game won by %A" player
moveResult
| GameTied display ->
printfn "LOGINFO: Game tied"
moveResult
/// inject logging into the API
let injectLogging api =
// create a new API with the functions
// replaced with logged versions
{ api with
newGame = fun () -> api.newGame() |> transformMoveResult
}
// -----------------------------------------------------------
// ConsoleApplication
// -----------------------------------------------------------
module ConsoleApplication =
let startGame() =
let api = TicTacToeImplementation.api
let loggedApi = Logger.injectLogging api
ConsoleUi.startGame loggedApi
(*
To play in a IDE:
1) first highlight all code in the file and "Execute in Interactive" or equivalent
2) Uncomment the ConsoleApplication.startGame() line below and execute it
To play in command line:
1) Uncomment the ConsoleApplication.startGame() line below and execute the entire file using FSI
*)
// ConsoleApplication.startGame()
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment