-
Notifications
You must be signed in to change notification settings - Fork 0
/
stupid.hs
107 lines (87 loc) · 2.71 KB
/
stupid.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
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
106
107
import System.Environment (getArgs)
import Control.Applicative ((<$>), (<*>))
import Control.Error
import qualified Data.Text.IO as T
import Data.Maybe (fromJust)
import Types
import ParseInput
import DSL
import CardFuncs
import Interpreters
main = do
inFile <- fmap head getArgs
input <- T.readFile inFile
mapM_ runProg (parseInput input)
putStr "\r\n"
runProg :: GameData -> IO ()
runProg = flip quietInterp attackStage
attackStage = do
t <- getTrump
c@(Card _ rank) <- fromJust . (minCard t) <$> getHand Offense
attackWith c
passStage rank
passStage rank = do
t <- getTrump
nOff <- length <$> getHand Offense
nTable <- length <$> getTable
card <- (minCard t . cardsRanked rank) <$> getHand Defense
case (compare nOff nTable, card) of
-- offense has enough cards && defense has one to play
(GT, Just card') -> do
passWith card'
passStage rank
-- else...
_ -> defendStage
where
cardsRanked r = filter ((r ==) . cRank)
defendStage = do
t <- getTrump
hand <- getHand Defense
mTarget <- minPlayedCard t <$> uncoveredCards
mVolunteer <- runMaybeT $ do
target <- hoistMaybe mTarget
volunteer (card target)
case (mTarget, mVolunteer) of
(Just tar, Just vol) -> do
defend tar vol
defendStage
_ -> reinforceStage
uncoveredCards :: GameDSL [PlayedCard]
uncoveredCards = filter ((== Nothing) . cover) <$> getTable
volunteer :: Card -> MaybeT GameDSL Card
volunteer card@(Card suit _) = MaybeT $ do
t <- getTrump
hand <- getHand Defense
let sameSuit = filter (> card) $ cardsSuited suit hand
trumps = if suit /= t
then cardsSuited t hand
else [] -- trumps already exist in sameSuit
volunteers = sameSuit ++ trumps
return $ minCard t volunteers
where
cardsSuited s = filter ((s ==) . cSuit)
reinforceStage = do
nUnc <- length <$> uncoveredCards
nDef <- length <$> getHand Defense
reinforcements <- (take (nDef - nUnc)) <$> possibleReinforcements
case reinforcements of
[] -> verdictStage nUnc
_ -> do
reinforceWith reinforcements
defendStage
where
possibleReinforcements = do
ranks <- map cRank <$> playedCards
filter ((`elem` ranks) . cRank) <$> getHand Offense
verdictStage numUncovered = do
case numUncovered of
0 -> winTurn Defense
_ -> winTurn Offense
(oHand, dHand) <- (,)
<$> getHand Offense
<*> getHand Defense
case (oHand, dHand) of
([], []) -> tieGame
(_ , []) -> winner Defense
([], _) -> winner Offense
_ -> attackStage