-
Notifications
You must be signed in to change notification settings - Fork 2
/
Main.hs
58 lines (48 loc) · 1.84 KB
/
Main.hs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
import Data.List
import Data.Maybe
import Data.Monoid
import Data.Default
import Control.Monad
import Control.Monad.Free
import Data.Functor.Rep
import Entities.Mark
import Entities.Coordinate
import Entities.Board
import Entities.Player
data Turn = Turn { player' :: Player, board' :: (Board Mark) }
data Play next
= Start next
| Ask (Coordinate () -> next)
| Wrong (Coordinate ()) next
| Loop Turn next
| Final String
type Playing = Free Play
rules :: Playing ()
rules = Free $ Start $ gameloop (Turn Crosses (def :: Board Mark)) where
gameloop :: Turn -> Playing ()
gameloop turn = case check (board' turn) of
Just E -> Free $ Loop turn $ continue turn
Just O -> Free $ Loop turn $ Free $ Final "Noughts win!"
Just X -> Free $ Loop turn $ Free $ Final "Crosses win!"
Nothing -> if not $ ended (board' turn)
then Free $ Loop turn $ continue turn
else Free $ Loop turn $ Free $ Final "Standoff here!"
continue :: Turn -> Playing ()
continue (Turn player board) = Free $ Ask $ \coordinate ->
if index board coordinate /= E
then Free $ Wrong coordinate $ gameloop $ Turn player board
else gameloop $ Turn (another player) $
change board (whose player) coordinate
ended :: Board Mark -> Bool
ended board = maybe True (const False) $ find (== E) $
index board (I_IV ()) : index board (I_V ()) : index board (I_VI ()) :
index board (II_IV ()) : index board (II_V ()) : index board (II_VI ()) :
index board (III_IV ()) : index board (III_V ()) : index board (III_VI ()) : []
run :: Playing () -> IO ()
run (Pure r) = return r
run (Free (Start next)) = run next
run (Free (Ask f)) = print "Your turn: " >> ask >>= run . f
run (Free (Wrong coordinate next)) = print ((show coordinate) ++ " already filled") >> run next
run (Free (Loop turn next)) = print (board' turn) >> run next
run (Free (Final message)) = print message
main = run rules