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
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
|
{-# LANGUAGE StandaloneDeriving #-}
-- vim: sw=2 ts=2 et ai:
import Data.Attoparsec.ByteString.Char8
import Data.ByteString.Char8 (pack)
import Data.Either
import Data.List
import Control.Monad
import Test.QuickCheck
import Chess
import Chess.FEN
import Chess.PGN
import qualified ArbitraryMove as AM
deriving instance Eq PGN
instance Arbitrary GameResult where arbitrary = elements [BlackWon, WhiteWon, Draw]
instance Arbitrary Board where arbitrary = return defaultBoard
type Move = String
arbitraryMove :: Gen Move
arbitraryMove = frequency
[ (2, AM.arbitraryMove)
, (1, invalidMove)
]
where
invalidMove :: Gen Move
invalidMove = oneof
[ liftM2 (\r c -> [r,c]) (choose ('i', 'z')) (elements "09")
]
instance Arbitrary PGN
where
arbitrary = liftM9 PGN
sensibleString
sensibleString
sensibleString
sensibleString
sensibleString
sensibleString
arbitrary
(Just <$> arbitrary)
(liftM2 (:) arbitraryMove (listOf arbitraryMove))
where
liftM9 f m1 m2 m3 m4 m5 m6 m7 m8 m9 = do
x1 <- m1
x2 <- m2
x3 <- m3
x4 <- m4
x5 <- m5
x6 <- m6
x7 <- m7
x8 <- m8
x9 <- m9
return $ f x1 x2 x3 x4 x5 x6 x7 x8 x9
sensibleString = listOf $ choose ('a', 'z')
main = quickCheck (withMaxSuccess 10000 checkPGN)
where
checkPGN :: PGN -> Bool
checkPGN pgn
| isLeft parsed = False
| length parsed' /= 1 = False
| otherwise = pgn == ((head parsed') {initialPosition=Just defaultBoard})
where
parsed = parseOnly pgnParser (pack $ pgnToString pgn)
(Right parsed') = parsed
pgnToString :: PGN -> String
pgnToString pgn = makePGN
(event pgn)
(site pgn)
(date pgn)
(Chess.PGN.round pgn)
(whitePlayer pgn)
(blackPlayer pgn)
(resultString $ result pgn)
("1. " ++ intercalate " 1. " (moves pgn) ++ " " ++ resultString (result pgn))
where
resultString :: Maybe GameResult -> String
resultString Nothing = "*"
resultString (Just WhiteWon) = "1-0"
resultString (Just BlackWon) = "0-1"
resultString (Just Draw) = "1/2-1/2"
makePGN :: String -> String -> String -> String -> String -> String -> String -> String -> String
makePGN event site date round white black result moves =
concatMap (uncurry tagPair)
[ ("Event", event)
, ("Site", site)
, ("Date", date)
, ("Round", round)
, ("White", white)
, ("Black", black)
, ("Result", result)
] ++ "\r\n" ++ moves
where
tagPair :: String -> String -> String
tagPair tag val = "[" ++ tag ++ " \"" ++ val ++ "\"]\r\n"
|
