Commits

Philip Xu committed 73f3c0b

Moved logic into monadic interface

Comments (0)

Files changed (2)

 let count (_, c, _) = c
 let score (_, _, s) = s
 
-let move_and_score move (grid, count, score) =
-  let sum = List.fold_left (+) 0 in
-  let grid', removed = move grid in
-  let score' = List.flatten removed |> sum in
-  let is_changed = score' <> 0 || grid' <> grid in
-  grid', (if is_changed then succ count else count), score + score'
+module Monad = struct
+  let return grid = (grid, 0, 0)
+  let bind (grid, count, score) move =
+    let sum = List.fold_left (+) 0 in
+    let grid', removed = move grid in
+    let score' = List.flatten removed |> sum in
+    let is_changed = score' <> 0 || grid' <> grid in
+    grid', (if is_changed then succ count else count), score + score'
+end
 
-let move_left = move_and_score Grid.move_left
-let move_right = move_and_score Grid.move_right
-let move_up = move_and_score Grid.move_up
-let move_down = move_and_score Grid.move_down
+module Infix = struct
+  let ( >>= ) = Monad.bind
+end
 
 let spawn (grid, count, score) =
   match Grid.empty_cells grid with
       let num = if (Random.int 10 = 0) then 4 else 2 in
       (Grid.set x y num grid, count, score)
   | None -> (grid, count, score)
+
+open Infix
+
+let move_left board = board >>= Grid.move_left
+let move_right board = board >>= Grid.move_right
+let move_up board = board >>= Grid.move_up
+let move_down board = board >>= Grid.move_down
 
 type t = state * Board.t
 
-module Monad = struct
-  let return board = (Playing, board)
-  let bind game action =
-    match game with
-    | (Playing, board) -> action board
-    | game -> game
-end
-
-module Infix = struct
-  let ( >>= ) = Monad.bind
-end
-
 let state (s, _) = s
 let board (_, b) = b
 let count (_, b) = Board.count b
 
 let winning_number = 2048
 
-let playing = Monad.return
+let playing board = (Playing, board)
 let lose board = (Lose, board)
 let win board = (Win, board)
 
   else
     lose board
 
-let spawn board = playing (Board.spawn board)
+module Monad = struct
+  let return board = (Playing, board)
+  let bind game action =
+    match game with
+    | Playing, board ->
+        begin match action board with
+        | Playing, board' -> check board'
+        | game -> game
+        end
+    | game -> game
+  let lift f game = board game |> f |> return
+end
 
-let play movement board =
-  let board' = movement board in
-  let not_changed = board = board' in
-  if not_changed then
-    playing board
-  else let open Infix in
-    playing board' >>= spawn >>= check
+module Infix = struct
+  let ( >>= ) = Monad.bind
+end
+
+let spawn board = Board.spawn board |> playing
 
 let move m game =
   let open Infix in
   | Down -> Board.move_down
   | Left -> Board.move_left
   | Right -> Board.move_right
-  in game >>= play action
+  in Monad.lift action game >>= spawn
 
 let init x y =
   Random.self_init ();