hanabi-dealer 0.4.0.1 → 0.5.0.0

raw patch · 5 files changed

+302/−110 lines, 5 filesdep +http-typesdep +waidep +wai-websocketsdep ~timePVP ok

version bump matches the API change (PVP)

Dependencies added: http-types, wai, wai-websockets, warp

Dependency ranges changed: time

API changes (from Hackage documentation)

Files

• ChangeLog.md +14/−0
• Game/Hanabi.hs +152/−56
• Game/Hanabi/Backend.lhs +15/−4
• Game/Hanabi/Client.hs +100/−44
• hanabi-dealer.cabal +21/−6

@@ -1,5 +1,19 @@ # Revision history for hanabi-dealer +	## 0.5.0.0 -- 2020-02-05++	* implement possibility marks which represent what colors and what numbers are possible for each card++	* introduce utility functions using the information of possibilities, and redesign the set of utilities++	* implement isDoubleDrop and warnDoubleDrop++	* enable customizing verbosity from the client++	* support Warp as the WebSocket server++	* add the jsaddle flag+ 	## 0.4.0.1 -- 2020-01-29  	* fix the bug of the endgame behavior that crept in during the switch to 0.4.0.0

@@ -11,12 +11,13 @@               -- ** The Game State and Interaction History               Move(..), Index, State(..), PrivateView(..), PublicInfo(..), Result(..), EndGame(..),               -- ** The Cards-              Card(..), Color(..), Number(..), Marks, cardToInt, intToCard, readsColorChar, readsNumberChar,+              Card(..), Color(..), Number(..), Marks, Possibilities, cardToInt, intToCard, readsColorChar, readsNumberChar,               -- * Utilities               -- ** Hints-              isCritical, isUseless, bestPossibleRank, achievedRank, isPlayable, isHinted, isObviouslyUseless, isMoreObviouslyPlayable, isObviouslyPlayable, invisibleBag, chops, chopss,+              isCritical, isUseless, bestPossibleRank, achievedRank, isPlayable, isHinted,+              isMoreObviouslyUseless, isObviouslyUseless, isDefinitelyUseless, isMoreObviouslyPlayable, isObviouslyPlayable, isDefinitelyPlayable, obviousChopss, definiteChopss, isDoubleDrop,               -- ** Minor ones-              what'sUp, what'sUp1, ithPlayer, recentEvents, prettyPI, ithPlayerFromTheLast, view, replaceNth, shuffle) where+              what'sUp, what'sUp1, ithPlayer, recentEvents, prettyPI, ithPlayerFromTheLast, view, replaceNth, shuffle, showPossibilities, showColorPossibilities, showNumberPossibilities) where -- module Hanabi where import qualified Data.IntMap as IM import System.Random@@ -24,9 +25,11 @@ import Control.Monad.IO.Class(MonadIO, liftIO) import Data.Char(isSpace, isAlpha, isAlphaNum, toLower, toUpper) import Data.Maybe(fromJust)-import Data.List(isPrefixOf, group)+import Data.List(isPrefixOf, group, zipWith4) import System.IO import Data.Dynamic+import Data.Bits hiding (rotate)+import Numeric(showIntAtBase, showOct)  import GHC.Generics hiding (K1) @@ -155,12 +158,14 @@                                                        -- Negative hints should also be implemented, but they should be kept separate from givenHints,                                                       -- in order to guess the behavior of algorithms that do not use such information.+                     , possibilities :: [[Possibilities]]                      , result :: Result               -- ^ The result of the last move. This info may be separated from 'PublicInfo' in future.                      } deriving (Read, Show, Eq, Generic)  -- | 'Marks' is the type synonym representing the hint trace of a card. type Marks = (Maybe Color, Maybe Number) +type Possibilities = (Int, Int)  -- | the best achievable rank for each color. bestPossibleRank :: PublicInfo -> Color -> Number@@ -195,33 +200,70 @@ isMoreObviouslyPlayable :: PublicInfo -> Marks -> Bool isMoreObviouslyPlayable pub = iOP (nonPublic pub) pub --- | In addition to 'isMoreObviouslyPlayable', 'isObviouslyPlayable' also looks at other players' hand and decides if the card is surely playable.-isObviouslyPlayable :: PrivateView -> Marks -> Bool-isObviouslyPlayable pv = iOP (invisibleBag pv) (publicView pv)+-- | In addition to 'isMoreObviouslyPlayable', 'isObviouslyPlayable' also looks into the color/number possibilities of the card and decides if the card is surely playable.+isObviouslyPlayable :: PublicInfo -> Possibilities -> Bool+isObviouslyPlayable pub (pc,pn) = all (\card -> (nonPublic pub IM.! cardToInt card) == 0 || isPlayable pub card)+                                      [ C color number | color <- colorPossibilities pc, number <- numberPossibilities pn ] +-- | In addition to 'isObviouslyPlayable', 'isDefinitelyPlayable' also looks at other players' hand and decides if the card is surely playable.+{- This is a weaker version not looking into the possibilities.+isDefinitelyPlayable :: PrivateView -> Marks -> Bool+isDefinitelyPlayable pv = iOP (invisibleBag pv) (publicView pv)+-}+isDefinitelyPlayable :: PrivateView -> Marks -> Possibilities -> Bool+isDefinitelyPlayable pv (Just c, Just n) _       = isPlayable (publicView pv) $ C c n -- The condition is indispensable, because now invisibleBag considers fully-marked cards visible.+isDefinitelyPlayable pv _                (pc,pn) = all (\card -> (invisibleBag pv IM.! cardToInt card) == 0 || isPlayable (publicView pv) card)+                                                       [ C color number | color <- colorPossibilities pc, number <- numberPossibilities pn ]++ iOP bag pub (Just c, Just n) = isPlayable pub $ C c n-iOP bag pub (Nothing,Just n) = all (isPlayable pub) [ card | color <- colors pub, let card = C color n, (bag IM.! cardToInt card) > 0 ]+iOP bag pub (Nothing,Just n) = all (\card -> (bag IM.! cardToInt card) == 0 || isPlayable pub card) [ C color n | color <- colors pub ] iOP _   _   _                = False  -- | 'isMoreObviouslyUseless' looks at the publicly available current info and decides if the card is surely useless.-isObviouslyUseless :: PublicInfo -> Marks -> Bool-isObviouslyUseless pub (Just c,  Just n)  = isUseless pub $ C c n-isObviouslyUseless pub (Just c,  Nothing) = bestPossibleRank pub c == achievedRank pub c-isObviouslyUseless pub (Nothing, Just n)  = all (\c -> n <= achievedRank pub c || bestPossibleRank pub c < n) $ colors pub-isObviouslyUseless pub (Nothing, Nothing) = False+isMoreObviouslyUseless :: PublicInfo -> Marks -> Bool+isMoreObviouslyUseless pub (Just c,  Just n)  = isUseless pub $ C c n+isMoreObviouslyUseless pub (Just c,  Nothing) = bestPossibleRank pub c == achievedRank pub c+isMoreObviouslyUseless pub (Nothing, Just n)  = all (\c -> n <= achievedRank pub c || bestPossibleRank pub c < n) $ colors pub+isMoreObviouslyUseless pub (Nothing, Nothing) = False +isObviouslyUseless :: PublicInfo -> Possibilities -> Bool+isObviouslyUseless pub (pc,pn) = all (\card@(C c n) -> n <= achievedRank pub c || bestPossibleRank pub c < n || (nonPublic pub IM.! cardToInt (C c n)) == 0 )+                                     [ C color number | color <- colorPossibilities pc, number <- numberPossibilities pn ]++isDefinitelyUseless :: PrivateView -> Marks -> Possibilities -> Bool+isDefinitelyUseless pv (Just c, Just n) _       = isUseless (publicView pv) $ C c n -- The condition is indispensable, because now invisibleBag considers fully-marked cards visible.+isDefinitelyUseless pv _                (pc,pn) = all (\card@(C c n) -> n <= achievedRank pub c || bestPossibleRank pub c < n || (invisibleBag pv IM.! cardToInt card) == 0 )+                                                      [ C color number | color <- colorPossibilities pc, number <- numberPossibilities pn ]+                            where pub = publicView pv++{- This is a weaker version not looking into the possibilities.+isDefinitelyUseless :: PrivateView -> Marks -> Bool+isDefinitelyUseless pv (Just c,  Just n)  = isUseless (publicView pv) $ C c n+isDefinitelyUseless pv (Just c,  Nothing) = all ((==0) . (invisibleBag pv IM.!) . cardToInt . C c . toEnum) [ succ $ fromEnum $ achievedRank (publicView pv) c .. fromEnum $ bestPossibleRank (publicView pv) c ] +isDefinitelyUseless pv (Nothing, Just n)  = all (\c -> n <= achievedRank (publicView pv) c || bestPossibleRank (publicView pv) c < n || (invisibleBag pv IM.! cardToInt (C c n)) == 0 ) $ colors $ publicView pv+isDefinitelyUseless pv (Nothing, Nothing) = all (\c -> all ((==0) . (invisibleBag pv IM.!) . cardToInt . C c . toEnum) [ succ $ fromEnum $ achievedRank (publicView pv) c .. fromEnum $ bestPossibleRank (publicView pv) c ]) $ colors $ publicView pv+-}+-- In fact, invisibleBag should be included in PrivateView for efficiency of isDefinitelyUseless, etc., but should not be sent via WebSocket. This is the matter of Read and Show (or ToJSON and FromJSON).++ -- | @'choppiri' marks@ = [unmarked last, unmarked second last, ...]. This is "beginner players' idea of chops".  choppiri :: [Marks] -> [(Index, Marks)] choppiri = reverse . filter (not . isHinted . snd) . zip [0..] --- | In addition to 'choppiri', 'chopss' considers 'isObviouslyUseless'. Since "from which card to drop among obviously-useless cards" depends on conventions, cards with the same uselessness are wrapped in a list within the ordered list.-chopss :: PublicInfo -> [Marks] -> [[(Index, Marks)]]-chopss pub hls = (if null useless then id else (useless :)) $ map (:[]) (choppiri hls)-   where useless = filter (isObviouslyUseless pub . snd) (zip [0..] hls)--- | 'chops' is the flattened version of 'chopss'-chops :: PublicInfo -> [Marks] -> [(Index, Marks)]-chops pub hls = concat $ map reverse $ chopss pub hls+-- | In addition to 'choppiri', 'definiteChopss' and 'obviousChopss' consider 'isDefinitelyUseless' and 'isObviouslyUseless' respectively. Since "from which card to drop among obviously-useless cards" depends on conventions, cards with the same uselessness are wrapped in a list within the ordered list.+definiteChopss :: PrivateView -> [Marks] -> [Possibilities] -> [[Index]]+definiteChopss pv hls ps = (if null useless then id else (useless :)) $ map ((:[]) . fst) (choppiri hls)+   where useless = map fst $ filter (uncurry (isDefinitelyUseless pv) . snd) (zip [0..] $ zip hls ps)+obviousChopss :: PublicInfo -> [Marks] -> [Possibilities] -> [[Index]]+obviousChopss pub hls ps = (if null useless then id else (useless :)) $ map ((:[]) . fst) (choppiri hls)+   where useless = map fst $ filter (isObviouslyUseless pub . snd) (zip [0..] ps)+-- | 'chops' is the flattened version of 'obviousChopss'+chops :: PublicInfo -> [Marks] -> [Possibilities] -> [Index]+chops pub hls ps = concat $ map reverse $ obviousChopss pub hls ps +isDoubleDrop pv (Discard c) [i] (pc,pn) | isCritical (publicView pv) c = color c `elem` colorPossibilities pc && number c `elem` numberPossibilities pn && (invisibleBag pv IM.! cardToInt c) > 0+isDoubleDrop _pv _lastresult _chopset _ps = False  colors :: PublicInfo -> [Color] colors pub = take (numColors $ rule $ gameSpec pub) [minBound .. maxBound]@@ -250,56 +292,95 @@                       , handsPV :: [[Card]]           -- ^ Other players' hands. [next player's hand, second next player's hand, ...]                                                       --   This is based on the viewer's viewpoint (unlike 'hands' which is based on the current player's viewpoint),                                                       --   and the view history @[PrivateView]@ must be from the same player's viewpoint (as the matter of course).-                      } deriving (Read, Show, Eq, Generic)--- | 'invisibleBag' returns the bag of unknown cards (which are either in the pile or in the player's hand and not fully hinted).-invisibleBag :: PrivateView-                -> IM.IntMap Int -- ^ @'Card' -> Int@-invisibleBag pv = foldr (IM.update (Just . pred)) (nonPublic $ publicView pv) $ map cardToInt $ concat $ [ C c n | (Just c, Just n) <- head $ givenHints $ publicView pv ] : handsPV pv+                      , invisibleBag :: IM.IntMap Int -- ^ @'Card' -> Int@. 'invisibleBag' is the bag of unknown cards (which are either in the pile or in the player's hand and not fully hinted).+                      } deriving (Generic) -- ToDo: Instance for Generic should also be specialized for efficiency.+instance Show PrivateView where+  showsPrec p (PV pub h _) = showsPrec p (pub,h)+instance Read PrivateView where+  readsPrec p str = [ (mkPV pub hs, rest) | ((pub,hs), rest) <- readsPrec p str ]+instance Eq PrivateView where+  PV pub1 hs1 _ == PV pub2 hs2 _ = (pub1,hs1) == (pub2,hs2) +-- | 'mkPV' is the constructor of PrivateView.+mkPV pub hs = PV pub hs $ foldr (IM.update (Just . pred)) (nonPublic pub) $ map cardToInt $ concat $ [ C c n | (Just c, Just n) <- head $ givenHints pub ] : hs+ prettyPV :: Verbosity -> PrivateView -> String prettyPV v pv@PV{publicView=pub} = prettyPI pub ++ "\nMy hand:\n"-                                              ++ concat (replicate (length myHand) " __") ++ "\n"---                                              ++ concat [ if markObviouslyPlayable v && isObviouslyPlayable pv h then " _^" else " __" | h <- myHand ] ++"\n"-                                              ++ concat (replicate (length myHand) "|**") ++ "|\n"-                                              ++ (if markHints v then showHintLine myHand else "")+                                              ++ concat (replicate (length myHand) $ wrap "+--+") ++ "\n"+--                                              ++ concat [ if markObviouslyPlayable v && isDefinitelyPlayable pv h then " _^" else " __" | h <- myHand ] ++"\n"+                                              ++ concat (replicate (length myHand) $ wrap "|**|") ++ "\n"+                                              ++ (if markHints v then showHintLine wrap myHand else "")                                      -- x         ++ concat (replicate (length myHand) " ~~") ++ "\n" -- x                                             ++ concat [ '+':shows d "-" | d <- [0 .. pred $ length myHand] ]-                                              ++ concat [ '+':(if markChops v && d `elem` map fst (concat $ take 1 $ chopss pub myHand) then ('X':) else shows d)-                                                                      (if markObviouslyUseless  v && isObviouslyUseless pub h then "." else-                                                                       if markObviouslyPlayable v && isObviouslyPlayable pv h then "^" else "-") | (d,h) <- zip [0..] myHand ]+                                              ++ concat [ wrap $+                                                          '+':(if warnDoubleDrop v && isDoubleDrop pv (result pub) chopSet p && d `elem` chopSet then ('D':) else+                                                               if markChops v && d `elem` chopSet then ('X':) else shows d)+                                                                      (if markObviouslyUseless  v && isDefinitelyUseless pv h p then ".+" else+                                                                       if markObviouslyPlayable v && isDefinitelyPlayable pv h p then "^+" else "-+") | (d,h,p) <- zip3 [0..] myHand myPos ] -                                              ++ concat (zipWith3 (prettyHand v pub (ithPlayer $ numPlayers $ gameSpec pub)) [1..] (handsPV pv) $ tail $ givenHints pub)+                                              ++"\n"+                                              ++ (if markPossibilities v then showPosLines $ head $ possibilities pub else "")+                                              ++ concat (zipWith4 (prettyHand v pub (ithPlayer $ numPlayers $ gameSpec pub)) [1..] (handsPV pv) (tail $ givenHints pub) (tail $ possibilities pub))++"\n"   where myHand = head (givenHints pub)-prettySt ithP st@St{publicState=pub} = prettyPI pub ++ concat (zipWith3 (prettyHand verbose pub (ithP $ numPlayers $ gameSpec pub)) [0..] (hands st) $ givenHints pub)-verbose = V{warnCritical=True,markUseless=True,markPlayable=True,markObviouslyUseless=True,markObviouslyPlayable=True,markHints=True,markChops=True}-prettyHand :: Verbosity -> PublicInfo -> (Int->String) -> Int -> [Card] -> [Marks] -> String-prettyHand v pub ithPnumP i cards hl = "\n\n" ++ ithPnumP i ++ " hand:\n"+        myPos  = head (possibilities pub)+        wrap xs | markPossibilities v = "  "++xs++" "+                | otherwise           = xs+        chopSet = concat $ take 1 $ definiteChopss pv myHand myPos+prettySt ithP st@St{publicState=pub} = prettyPI pub ++ concat (zipWith4 (prettyHand verbose pub (ithP $ numPlayers $ gameSpec pub)) [0..] (hands st) (givenHints pub) (possibilities pub))+verbose = V{warnCritical=True,markUseless=True,markPlayable=True,markObviouslyUseless=True,markObviouslyPlayable=True,markHints=True,markPossibilities=True,markChops=True,warnDoubleDrop=True}+prettyHand :: Verbosity -> PublicInfo -> (Int->String) -> Int -> [Card] -> [Marks] -> [Possibilities] -> String+prettyHand v pub ithPnumP i cards hl ps = "\n\n" ++ ithPnumP i ++ " hand:\n" --                          ++ concat (replicate (length cards) " __") ++ " \n"-                          ++ concat [ if markUseless v && isUseless pub card then " .."+                          ++ concat [ wrap $+                                      if markUseless v && isUseless pub card then "+..+"                                       else case (warnCritical v && tup==(Nothing,Nothing) && isCritical pub card, markPlayable v && isPlayable pub card) of-                                             (True, True)  -> " !^"-                                             (True, False) -> " !!"-                                             (False,True)  -> " _^"-                                             (False,False) -> " __"+                                             (True, True)  -> "+!^+"+                                             (True, False) -> "+!!+"+                                             (False,True)  -> "+-^+"+                                             (False,False) -> "+--+"                                     | (card, tup) <- zip cards hl ] ++"\n"-                          ++ concat [ '|':show card | card <- cards ] ++"|\n"-                          ++ (if markHints v then showHintLine hl else "")+                          ++ concat [ wrap $ '|':shows card "|" | card <- cards ] ++"\n"+                          ++ (if markHints v then showHintLine wrap hl else "") -- x                          ++ concat (replicate (length cards) "+--")-                          ++ concat [ '+':(if markChops v && map fst (take 1 $ chops pub hl) == [d] then ('X':) else ('-':))-                                             (if markObviouslyUseless  v && isObviouslyUseless      pub h then "." else-                                              if markObviouslyPlayable v && isMoreObviouslyPlayable pub h then "^" else "-") | (d,h) <- zip [0..] hl ]+                          ++ concat [ wrap $+                                      '+':(if markChops v && d `elem` (concat $ take 1 $ obviousChopss pub hl ps) then ('X':) else ('-':))+                                             (if markObviouslyUseless  v && isObviouslyUseless  pub h then ".+" else+                                              if markObviouslyPlayable v && isObviouslyPlayable pub h then "^+" else "-+") | (d,h) <- zip [0..] ps ]++"\n"+                          ++ (if markPossibilities v then showPosLines ps else "")+                    where wrap xs | markPossibilities v = "  "++xs++" "+                                  | otherwise           = {- take 3 -} xs -showHintLine :: [Marks] -> String-showHintLine hl = '|' : concat [ maybe ' ' (head . show) mc : maybe ' ' (head . show . fromEnum) mk : "|" | (mc,mk) <- hl] ++ "\n" +showHintLine :: (String -> String) -> [Marks] -> String+showHintLine wrapper hl = concat [ wrapper $ '|' : maybe ' ' (head . show) mc : maybe ' ' (head . show . fromEnum) mk : "|" | (mc,mk) <- hl] ++ "\n"+showPosLines :: [Possibilities] -> String+showPosLines ps = concat [ ' ' : showColorPossibilities  cs | (cs,_) <- ps] ++ "\n"+               ++ concat [ showNumberPossibilities ns ++" " | (_,ns) <- ps]++showColorPossibilities  = reverse . showPossibilities ' ' colorkeys+showNumberPossibilities = reverse . showPossibilities ' ' "54321 "+colorkeys = map (head . show) [maxBound, pred maxBound .. minBound::Color] -- colorkeys == "MBGRYW", but I just prefer to make this robust to changes in the order.+showPossibilities _     []     pos = []+showPossibilities blank (x:xs) pos = (if odd pos then x else blank) : showPossibilities blank xs (pos `div` 2)++colorPossibilities  :: Int -> [Color] -- The result is in the reverse order but I do not care.+colorPossibilities  = concat . showPossibilities [] (map (:[]) [maxBound, pred maxBound .. minBound])+numberPossibilities :: Int -> [Number] -- The result is in the reverse order but I do not care.+numberPossibilities = concat . showPossibilities [] (map (:[]) [K5,K4 .. K1])+++ -- | 'Verbosity' is the set of options used by verbose 'Strategy's data Verbosity = V { warnCritical :: Bool -- ^ mark unhinted critical cards with "!!" ("!^" if it is playable and markPlayable==True.)-                   , markUseless  :: Bool -- ^ mark useless  cards with ".."+                   , markUseless  :: Bool -- ^ mark useless  cards with "..".                    , markPlayable :: Bool -- ^ mark playable cards with "_^". ("!^" if it is unhinted critical and warnCritical==True.)                    , markObviouslyUseless  :: Bool -- ^ mark useless  cards with "_." based on the hint marks.                    , markObviouslyPlayable :: Bool -- ^ mark playable cards with "_^" based on the hint marks.                    , markChops     :: Bool -- ^ mark the chop card(s) with "X". All obviously-useless cards will be marked, if any.-                   , markHints    :: Bool -- ^ mark hints.+                   , warnDoubleDrop:: Bool -- ^ mark the chop card with "D" when dropping it is double-dropping.+                   , markHints     :: Bool -- ^ mark hints.+                   , markPossibilities :: Bool -- ^ mark more detailed hints based on the positive/negative hint history.+                                               --   markPossibilities == True && markHints == False is a reasonable choice, though markHints should still be informative for guessing other players' behavior.                    } deriving (Read, Show, Eq, Generic)  @@ -320,8 +401,7 @@             ++ "\ndropped: " ++ concat [ '|' : concat (replicate n $ show $ intToCard ci) | (ci,n) <- IM.toList $ discarded pub ] ++"|\n"  view :: State -> PrivateView-view st = PV {publicView = publicState st,-              handsPV    = tail $ hands st}+view st = mkPV (publicState st) (tail $ hands st)  main = selfplay defaultGS @@ -536,6 +616,7 @@                                             hintTokens = 8,                                             deadline   = Nothing,                                             givenHints = replicate (numPlayers gs) $ replicate (numPlayerHand gs) (Nothing, Nothing),+                                            possibilities = replicate (numPlayers gs) $ replicate (numPlayerHand gs) (unknown gs),                                             result     = None                                            },                            pile  = stack,@@ -549,6 +630,8 @@                [ (C i k, n) | i <- [White .. pred Multicolor], (k,n) <- numAssoc ] ++ [ (C Multicolor k, n) | (k, n) <- zip [K1 ..K5] (numMulticolors rule) ] cardBag rule = concat         [ replicate n c | (c,n) <- cardAssoc rule ] cardMap rule = IM.fromList [ (cardToInt c, n) | (c,n) <- cardAssoc rule ]+unknown :: GameSpec -> Possibilities+unknown gs = (64 - bit (6 - numColors (rule gs)),  31)  shuffle :: RandomGen g => [c] -> g -> ([c], g) shuffle xs = shuf [] xs $ length xs@@ -578,10 +661,12 @@   -- only used by Drop and Play   (nth, droppedHand) = pickNth (index mv) playersHand where playersHand = head $ hands st   (_  , droppedHint) = pickNth (index mv) playersHint where playersHint = head $ givenHints pub-  (nextHand,nextHint,nextPile, nextPileNum) = case pile st of []   -> (droppedHand,   droppedHint,                   [], 0)-                                                              d:ps -> (d:droppedHand, (Nothing,Nothing):droppedHint, ps, pred $ pileNum pub)+  (_  , droppedPos)  = pickNth (index mv) playersPos  where playersPos  = head $ possibilities pub+  (nextHand,nextHint,nextPos,nextPile, nextPileNum) = case pile st of []   -> (droppedHand,   droppedHint,                   droppedPos,              [], 0)+                                                                      d:ps -> (d:droppedHand, (Nothing,Nothing):droppedHint, unknown gS : droppedPos, ps, pred $ pileNum pub)   nextHands = nextHand : tail (hands st)   nextHints = nextHint : tail (givenHints pub)+  nextPoss  = nextPos  : tail (possibilities pub)   nextDeadline = case deadline pub of Nothing | nextPileNum==0 && not (prolong $ rule $ gameSpec pub) -> Just $ numPlayers gS                                               | otherwise                                             -> Nothing                                       Just i  -> Just $ pred i@@ -593,6 +678,7 @@                                       turn       = succ $ turn pub,                                       hintTokens = succ $ hintTokens pub,                                       givenHints = nextHints,+                                      possibilities = nextPoss,                                       deadline   = nextDeadline,                                       result     = Discard nth}}   prc (Play i) | failure   = let newst@St{publicState=newpub} = prc (Drop i) in newst{publicState=newpub{hintTokens = hintTokens pub, lives = pred $ lives pub, result = Fail nth}}@@ -604,12 +690,14 @@                                                   turn       = succ $ turn pub,                                                   hintTokens = if hintTokens pub < 8 && number nth == K5 then succ $ hintTokens pub else hintTokens pub,                                                   givenHints = nextHints,+                                                  possibilities = nextPoss,                                                   deadline   = nextDeadline,                                                   result = Success nth}}     where failure = not $ isPlayable pub nth   prc (Hint hintedpl eik) = st{publicState = pub{hintTokens = pred $ hintTokens pub,                                                  turn       = succ $ turn pub,                                                  givenHints = snd $ updateNth hintedpl newHints (givenHints pub),+                                                 possibilities = snd $ updateNth hintedpl newPoss (possibilities pub),                                                  deadline   = case deadline pub of Nothing -> Nothing                                                                                    Just i  -> Just $ pred i,                                                  result     = None}}@@ -617,11 +705,19 @@           zipper (C ir ka) (mi,mk) = case eik of Left  i | i==ir -> (Just i, mk)                                                  Right k | k==ka -> (mi, Just k)                                                  _               -> (mi,     mk)+          newPoss  hs = zipWith zipperPos (hands st !! hintedpl) hs+          zipperPos (C ir ka) (c,n) = case eik of Left i  | i == ir -> (bit ibit,        n)+                                                          |otherwise-> (clearBit c ibit, n)+                                                       where ibit = 5 - fromEnum i+                                                  Right k | k == ka -> (c, bit kbit)+                                                          |otherwise-> (c, clearBit n kbit)+                                                       where kbit = 5 - fromEnum k + -- | @'rotate' num@ rotates the first person by @num@ (modulo the number of players). rotate :: Int -> State -> State rotate num st@(St{publicState=pub@PI{gameSpec=gS}}) = st{hands       = rotateList $ hands st,-                                                         publicState = pub{givenHints = rotateList $ givenHints pub}}+                                                         publicState = pub{givenHints = rotateList $ givenHints pub, possibilities = rotateList $ possibilities pub}}     where rotateList xs = case splitAt (num `mod` numPlayers gS) xs of (tk,dr) -> dr++tk  -- | 'EndGame' represents the game score, along with the info of how the game ended.

@@ -1,5 +1,5 @@ \begin{code}-{-# LANGUAGE CPP, TupleSections, MultiParamTypeClasses, FlexibleInstances #-}+{-# LANGUAGE CPP, TupleSections, MultiParamTypeClasses, FlexibleInstances, OverloadedStrings #-} -- Do not forget -threaded! -- @@ -46,6 +46,13 @@ import Snap.Http.Server.Config import Snap.Http.Server import Data.ByteString.UTF8(fromString)+#else+# ifdef WARP+import Network.Wai.Handler.WebSockets+import Network.Wai.Handler.Warp as Warp+import Network.Wai(responseLBS)+import Network.HTTP.Types(status400)+# endif #endif  #ifdef AESON@@ -97,11 +104,14 @@     mv <- newMVar (IntMap.empty::IntMap.IntMap ([MVar ViaWebSocket], MVar (Maybe (EndGame,[State],[Move]))))     let params = Params{gen = g, mvTIDToMVH = mv, versionString = version options, gsConstructorMap = Map.fromList $ strategies options, conn = error "Game.Hanabi.Backend.server: should not happen"} #ifdef SNAP-    httpServe (setPort (port options) defaultConfig) $ runWebSocketsSnap+    httpServe (setPort (port options) defaultConfig) $ runWebSocketsSnap $ loop params #else-    runServer "127.0.0.1" (port options)+# ifdef WARP+    Warp.run (port options) $ websocketsOr defaultConnectionOptions (loop params) $ \_ resp -> resp $ responseLBS status400 [] "Not a WebSocket request."+# else+    runServer "127.0.0.1" (port options) $ loop params+# endif #endif-           $ loop params  data Params g = Params{gen :: g,                        mvTIDToMVH :: MVar (IntMap.IntMap ([MVar ViaWebSocket], MVar (Maybe (EndGame,[State],[Move])))),@@ -184,6 +194,7 @@ wordsBy pred xs = case break pred xs of (tk,  []) -> [tk]                                         (tk,_:dr) -> tk : wordsBy pred dr isWS = (`elem` ["0", "WS", "via WebSocket"])+ interpret :: RandomGen g =>              Maybe Verbosity -> String -> Params g -> IO () interpret mbVerb inp params

@@ -12,10 +12,11 @@ import           Data.Aeson   hiding (Success) import           GHC.Generics hiding (K1, from) import           Data.Bool+import           Data.Char(isSpace) import qualified Data.Map as M import qualified Data.IntMap as IM import Data.Maybe(fromJust, isNothing)-import Data.List(intersperse)+import Data.List(intersperse, zipWith4)  import           Miso         hiding (Fail) import           Miso.String  (MisoString)@@ -38,7 +39,7 @@  client :: Game.Hanabi.Msg.Options -> IO () client options = runApp $ startApp App{-    model  = Model{tboxval = Message "available", players = ["via WebSocket"], from = Just 0, rule = defaultRule, received = [], fullHistory = False},+    model  = Model{tboxval = Message "available", players = ["via WebSocket"], from = Just 0, rule = defaultRule, received = [], fullHistory = False, showVerbosity = False, verbosity = verbose},     update = updateModel,     view   = appView strNames $ version options,     subs   = [ websocketSub uri protocols HandleWebSocket ],@@ -65,7 +66,7 @@ updateModel :: Action -> Model -> Effect Action Model updateModel (HandleWebSocket (WebSocketMessage (Message m))) model   = noEff model{ received = {- take lenHistory $ -} decodeMsg m : received model }-updateModel (SendMessage msg) model = model{fullHistory=False} <# (-- connect uri protocols >>+updateModel (SendMessage msg) model = model{fullHistory=False, showVerbosity=False} <# (-- connect uri protocols >>                                                 send msg >> return Id) updateModel (UpdateTBoxVal m) model = noEff model{ tboxval = Message m } updateModel (From mbn)        model = noEff model{from = mbn}@@ -73,7 +74,9 @@ updateModel DecreasePlayers   model = noEff model{players = case players model of {n:ns@(_:_) -> ns; ns -> ns}} updateModel (UpdatePlayer ix pl) model = noEff model{players = snd $ replaceNth ix pl $ players model} updateModel (UpdateRule r)    model | isRuleValid r = noEff model{rule=r}+updateModel (UpdateVerbosity v) model = noEff model{verbosity = v} updateModel Toggle            model = noEff model{fullHistory = not $ fullHistory model}+updateModel ToggleVerbosity   model = noEff model{showVerbosity = not $ showVerbosity model} #ifdef DEBUG updateModel (HandleWebSocket act) model = noEff model{received = Str (show act) : received model } #endif@@ -94,7 +97,9 @@   | DecreasePlayers   | UpdatePlayer Int MisoString   | UpdateRule Rule+  | UpdateVerbosity Verbosity   | Toggle+  | ToggleVerbosity   | Id  data Model = Model {@@ -104,6 +109,8 @@   , rule :: Rule   , received :: [Msg]   , fullHistory :: Bool+  , showVerbosity :: Bool+  , verbosity :: Verbosity   } deriving (Show, Eq)  lenShownHistory = 10@@ -112,16 +119,42 @@    input_  [ type_ "text", placeholder_ "You can also use your keyboard.", size_ "25", onInput UpdateTBoxVal, onEnter (SendMessage tboxval) ]  , button_ [ onClick (SendMessage tboxval) ] [ text (S.pack "Send to the server") ] -- x , span_ [style_ $ M.fromList [("font-size","10px")]] [text $ S.pack "(Use this line if you prefer the keyboard interface.)"]- , span_ [style_ $ M.fromList [("font-size","10px"), ("float","right")]] [text $ S.pack $ "hanabi-dealer client "++versionInfo]++ , span_ [style_ $ M.fromList [("float","right")]] [+     button_ [ onClick ToggleVerbosity, id_ "verbutton" ] [ text $ if showVerbosity then "^" else "v" ]+   , label_ [for_ "verbutton"] [text "verbosity options" ]+   ]+ , if showVerbosity then span_ [style_ $ M.fromList [("clear","both"), ("float","right")]] [renderVerbosity verbosity] else span_[][]++ , span_ [style_ $ M.fromList [("clear","both"), ("font-size","10px"), ("float","right")]] [text $ S.pack $ "hanabi-dealer client "++versionInfo] -- , hr_ []- , div_ [style_ $ M.fromList [("clear","both")]] ((if fullHistory then id else take lenShownHistory) $ map (renderMsg strategies verbose mdl) received)+ , div_ [style_ $ M.fromList [("clear","both")]] ((if fullHistory then id else take lenShownHistory) $ map (renderMsg strategies verbosity mdl) received)  , div_ [] $ if null $ drop lenShownHistory received then [] else [      hr_ []    , input_ [ type_ "checkbox", id_ "showhist", onClick Toggle, checked_ fullHistory]    , label_ [for_ "showhist"] [text "Show full history"]    ]  ]+renderVerbosity :: Verbosity -> View Action+renderVerbosity v = div_ [] [+    mkChx v "mark unhinted critical cards" (\b -> v{warnCritical=b}) warnCritical,+    mkChx v "mark useless cards"           (\b -> v{markUseless=b})  markUseless,+    mkChx v "mark playable cards"          (\b -> v{markPlayable=b}) markPlayable,+    mkChx v "mark useless cards without looking at the cards"  (\b -> v{markObviouslyUseless=b}) markObviouslyUseless,  +    mkChx v "mark playable cards without looking at the cards" (\b -> v{markObviouslyPlayable=b}) markObviouslyPlayable,+    mkChx v "shade the chop card(s)"       (\b -> v{markChops=b})    markChops,+    mkChx v "warn possible double-dropping"(\b -> v{warnDoubleDrop=b}) warnDoubleDrop,+    mkChx v "mark hints"                   (\b -> v{markHints=b})    markHints,+    mkChx v "mark possibilities"           (\b -> v{markPossibilities=b}) markPossibilities+  ] ++mkChx verb label update access = div_ [] [+    input_ [ type_ "checkbox", id_ idName, onClick (UpdateVerbosity $ update $ not $ access verb), checked_ $ access verb ],+    label_ [ for_ idName ] [text label]+  ]+     where idName = S.filter (not.isSpace) label+ onEnter :: Action -> Attribute Action onEnter action = onKeyDown $ bool Id action . (== KeyCode 13) {-@@ -153,7 +186,7 @@ renderMsg _ verb _ (WhatsUp name ps ms) = renderWhatsUp  verb name ps ms renderMsg _ verb _ (WhatsUp1     p  m)  = renderWhatsUp1 verb p m renderMsg _ _    _ (PrettyEndGame Nothing)     = pre_ [] [ text $ S.pack $ prettyMbEndGame Nothing]-renderMsg _ _    _ (PrettyEndGame (Just tup))  = renderEndGame tup -- pre_ [] [ text $ S.pack $ prettyEndGame tup]+renderMsg _ verb _ (PrettyEndGame (Just tup))  = renderEndGame verb tup -- pre_ [] [ text $ S.pack $ prettyEndGame tup] renderMsg strategies _    mdl (PrettyAvailable games)   = div_ [style_ $ M.fromList [("overflow","auto")]] [       hr_ [],@@ -177,17 +210,26 @@ -- x                       ++ [tr_ [] [td_ [] [], td_ [] [input_ [type_ "radio", id_ "shuffle", onClick (From Nothing), checked_ $ from mdl == Nothing], --                                                        label_ [for_ "shuffle"] [text "shuffle the player list before the game"]]]]                      ,+--             div_ [] [text $ "Rules"],+--             div_ [] [input_ [type_ "text", onInput (UpdateRule . head . (++[rule mdl]) . map fst . reads . S.unpack), value_ $ S.pack $ show $ rule mdl, style_ $ M.fromList [("width","70%")]]],+              let mkTR label updater access = tr_ [] [                           td_ [] [text label],                           td_ [] [                              input_ [type_ "text", onInput (UpdateRule . updater . head . (++[access $ rule mdl]) . map fst . reads . S.unpack), value_ $ S.pack $ show $ access $ rule mdl]                             ]+                        ]+                 mkTRd label updater access options = tr_ [] [+                          td_ [] [text label],+                          td_ [] [+                             dropdownLiteral options (UpdateRule . updater) (access $ rule mdl)+                            ]                         ] in                table_ [solid] [                    caption_ [] [text "Rules"],-                   mkTR "Number of lives"                               (\n -> (rule mdl){numBlackTokens=n}) numBlackTokens,-                   mkTR "Number of colors"                              (\n -> (rule mdl){numColors=n})      numColors,-                   mkTR "Continue the game after the pile is exhausted" (\n -> (rule mdl){prolong=n})        prolong,+                   mkTRd "Number of lives"                               (\n -> (rule mdl){numBlackTokens=n}) numBlackTokens [1 .. 9],+                   mkTRd "Number of colors"                              (\n -> (rule mdl){numColors=n})      numColors      [1 .. 6],+                   mkTRd "Continue the game after the pile is exhausted" (\n -> (rule mdl){prolong=n})        prolong        [False,True],                    mkTR "numMulticolors"                                (\n -> (rule mdl){numMulticolors=n}) numMulticolors,                    mkTR "funPlayerHand"                                 (\n -> (rule mdl){funPlayerHand=n})  funPlayerHand                  ],@@ -198,9 +240,17 @@    ] renderPlayer :: [MisoString] -> Int -> MisoString -> View Action --renderPlayer _ i p = text p-renderPlayer strategies i p = select_ [onChange $ UpdatePlayer i] [ option_ [value_ p', selected_ $ p==p'] [text p'] | p' <- strategies ]+renderPlayer strategies i p = dropdown strategies (UpdatePlayer i) p +dropdown :: [MisoString] -> (MisoString->Action) -> MisoString -> View Action+dropdown options action selected = select_ [onChange action] [option_ [ value_ p, selected_ $ selected==p] [text p] | p <- options ] +dropdownLiteral :: (Read a, Show a) => [a] -> (a -> Action) -> a -> View Action+dropdownLiteral options action selected = dropdown (map (S.pack . show) options) (action . read . S.unpack) (S.pack $ show selected)++dropdownBool = dropdownLiteral [False,True]+-- but in most cases booleans should be selected by check boxes.+ renderAvailable (gameid, (missing, total))   = tr_ [onClick $ SendMessage $ Message $ S.pack $ "attend "++show gameid] [ td_ [solid] [text $ S.pack str] | str <- [show gameid, show missing, show total] ] solid = style_ $ M.fromList [("border-style","solid")]@@ -209,7 +259,7 @@   hr_ [],   text $ S.pack "Your turn.",   hr_ [],-  renderRecentEvents (publicView v) ithPlayer views moves,+  renderRecentEvents verb (publicView v) ithPlayer views moves,   hr_ [],   text $ S.pack $ "Algorithm: " ++ name,   renderPV verb v@@ -217,25 +267,25 @@ renderWhatsUp1 :: Verbosity -> PrivateView -> Move -> View Action renderWhatsUp1 verb v m = div_ [style_ $ M.fromList [("background-color","#555555"),("color","#000000")]] [   hr_ [],-  renderTrial (publicView v) (const "") undefined v m,+  renderTrial verb (publicView v) (const "") undefined v m,   hr_ [],   renderPV verb v  ] -renderEndGame :: (EndGame, [State], [Move]) -> View Action-renderEndGame (eg,sts@(st:_),mvs)+renderEndGame :: Verbosity -> (EndGame, [State], [Move]) -> View Action+renderEndGame verb (eg,sts@(st:_),mvs)   = div_ [] [          hr_ [],-         renderRecentEvents (publicState st) ithPlayerFromTheLast (map Game.Hanabi.view sts) mvs,+         renderRecentEvents verb (publicState st) ithPlayerFromTheLast (map Game.Hanabi.view sts) mvs,          hr_ [],          h1_ [style_ $ M.fromList [("background-color","#FF0000"),("color","#000000")]] [text $ S.pack $ show eg],          hr_ [],-         renderSt ithPlayerFromTheLast st,+         renderSt verb ithPlayerFromTheLast st,          hr_ []          ] -renderTrial :: PublicInfo -> (Int -> String) -> Int -> PrivateView -> Move -> View Action-renderTrial pub ithP i v m =  div_ [] [+renderTrial :: Verbosity -> PublicInfo -> (Int -> String) -> Int -> PrivateView -> Move -> View Action+renderTrial verb pub ithP i v m =  div_ [] [   text $ S.pack $ ithP i ++ " move: " ++ {- replicate (length (ithP 2) - length (ithP i)) ' ' ++ -} show m   , case result $ publicView v of Discard c -> showResults c ", which revealed "                                   Success c -> showResults c ", which succeeded revealing "@@ -245,10 +295,10 @@   where showResults c xs = span_ [] [             xs --          , renderHand' verbose pub [Just c] [(Nothing,Nothing)]-          , renderCardInline verbose pub c+          , renderCardInline verb pub c           , text $ S.pack "."           ]-renderPI pub+renderPI verb pub {- This was too verbose   = let       showDeck 0 = "no card at the deck (the game will end in " ++ shows (fromJust $ deadline pub) " turn(s)), "@@ -265,64 +315,70 @@        div_ [] [         text $ S.pack $ "played:",-        span_ [] [ span_ [] $ text (S.pack "|") : [ renderCardInline verbose pub $ C c k | k <- [K1 .. playedMax]] | c <- [White .. Multicolor], Just playedMax <- [IM.lookup (fromEnum c) (played pub)] ],+        span_ [] [ span_ [] $ text (S.pack "|") : [ renderCardInline verb pub $ C c k | k <- [K1 .. playedMax]] | c <- [White .. Multicolor], Just playedMax <- [IM.lookup (fromEnum c) (played pub)] ],         text $ S.pack "|"       ],        div_ [] [         text $ S.pack $ "dropped: ",-        span_ [] [ span_ [] $ text (S.pack "|") : (replicate n $ renderCardInline verbose pub $ intToCard ci) | (ci,n) <- IM.toList $ discarded pub ],+        span_ [] [ span_ [] $ text (S.pack "|") : (replicate n $ renderCardInline verb pub $ intToCard ci) | (ci,n) <- IM.toList $ discarded pub ],         text $ S.pack "|"       ]      ]-renderCardInline v pub c = span_ [style_ $ M.fromList [("width","30px"),("color", colorStr $ Just $ color c),("background-color","#000000")]] [cardStr verbose pub 0 (Just c) (Nothing,Nothing)]+renderCardInline v pub c = span_ [style_ $ M.fromList [("width","30px"),("color", colorStr $ Just $ color c),("background-color","#000000")]] [cardStr v pub 0 (Just c) (Nothing,Nothing)] -renderRecentEvents :: PublicInfo -> (Int -> Int -> String) -> [PrivateView] -> [Move] -> View Action-renderRecentEvents pub ithP vs@(v:_) ms = div_ [] $ reverse $ zipWith3 (renderTrial pub $ ithP nump) [pred nump, nump-2..0] vs ms+renderRecentEvents :: Verbosity -> PublicInfo -> (Int -> Int -> String) -> [PrivateView] -> [Move] -> View Action+renderRecentEvents verb pub ithP vs@(v:_) ms = div_ [] $ reverse $ zipWith3 (renderTrial verb pub $ ithP nump) [pred nump, nump-2..0] vs ms    where nump = numPlayers $ gameSpec $ publicView v   renderPV :: Verbosity -> PrivateView -> View Action renderPV v pv@PV{publicView=pub} = div_ [] [-  renderPI pub,+  renderPI v pub,   div_ [] ( --      div_ [] [text $ S.pack $ "My hand:"] : --      renderCards v pub [ Nothing | _ <- myHand] myHand :-      renderHand v pv (const "My") 0 [ Nothing | _ <- myHand] myHand :+      renderHand v pv (const "My") 0 [ Nothing | _ <- myHand] myHand (head $ possibilities pub) : --                                              ++ concat [ '+':shows d "-" | d <- [0 .. pred $ length myHand] ]-      (zipWith3 (renderHand v pv (ithPlayer $ numPlayers $ gameSpec pub)) [1..] (map (map Just) $ handsPV pv) $ tail $ givenHints pub)+      (zipWith4 (renderHand v pv (ithPlayer $ numPlayers $ gameSpec pub)) [1..] (map (map Just) $ handsPV pv) (tail $ givenHints pub) (tail $ possibilities pub))     )   ]   where myHand = head (givenHints pub) -renderSt ithP st@St{publicState=pub} = div_ [] $-  renderPI pub :-  zipWith3 (renderHand verbose (Game.Hanabi.view st) (ithP $ numPlayers $ gameSpec pub)) [0..] (map (map Just) $ hands st) (givenHints pub)+renderSt verb ithP st@St{publicState=pub} = div_ [] $+  renderPI verb pub :+  zipWith4 (renderHand verb (Game.Hanabi.view st) (ithP $ numPlayers $ gameSpec pub)) [0..] (map (map Just) $ hands st) (givenHints pub) (possibilities pub) -renderHand :: Verbosity -> PrivateView -> (Int->String) -> Int -> [Maybe Card] -> [Marks] -> View Action-renderHand v pv ithPnumP i mbcards hl = div_ [] [+renderHand :: Verbosity -> PrivateView -> (Int->String) -> Int -> [Maybe Card] -> [Marks] -> [Possibilities] -> View Action+renderHand v pv ithPnumP i mbcards hl ps = div_ [] [   div_ [] [text $ S.pack $ ithPnumP i ++ " hand:"],-   renderHand' v pv i mbcards hl+   renderHand' v pv i mbcards hl ps --  renderCards v pub (map Just cards) hl   ]-renderHand' :: Verbosity -> PrivateView -> Int -> [Maybe Card] -> [Marks] -> View Action-renderHand' v pv pli mbcards hl = -   table_ [style_ $ M.fromList [("border-color","#FFFFFF"), ("border-width","medium")]] [tr_ [style_ $ M.fromList [("background-color","#000000"), ("height","48px")]] (zipWith3 (renderCard v pv pli hl) [0..] mbcards hl)]+renderHand' :: Verbosity -> PrivateView -> Int -> [Maybe Card] -> [Marks] -> [Possibilities] -> View Action+renderHand' v pv pli mbcards hl ps = +   table_ [style_ $ M.fromList [("border-color","#FFFFFF"), ("border-width","medium")]] [tr_ [style_ $ M.fromList [("background-color","#000000"), ("height","48px")]] (zipWith4 (renderCard v pv pli hl ps) [0..] mbcards hl ps)] -renderCard :: Verbosity -> PrivateView -> Int -> [Marks] -> Index -> Maybe Card -> Marks -> View Action-renderCard v pv pli hl i mbc tup@(mc,mk) = td_ [style_ $ M.fromList [("width","36px"),-                                                                   ("color", colorStr $ fmap color mbc)]] [+renderCard :: Verbosity -> PrivateView -> Int -> [Marks] -> [Possibilities] -> Index -> Maybe Card -> Marks -> Possibilities -> View Action+renderCard v pv pli hl ps i mbc tup@(mc,mk) ptup@(pc,pn) = td_ [style_ $ M.fromList [("width","4em"),+                                                                                     ("color", colorStr $ fmap color mbc)]] [      maybe (button_ [ onClick (SendMessage $ Message $ S.pack $ 'p':show i) ] [ text (S.pack "play") ]) (const $ span_[][]) mbc,      div_ [] [         cardStr v pub pli mbc tup      ],      div_ [myStyle] [text $ S.pack $ if markHints v then maybe '_' (head . show) mc : [maybe '_' (head . show . fromEnum) mk] else "__" ],-     maybe (button_ [ onClick (SendMessage $ Message $ S.pack $ 'd':show i) ] [ text (S.pack "drop") ]) (const $ span_[][]) mbc+     maybe (button_ [ onClick (SendMessage $ Message $ S.pack $ 'd':show i) ] [ text (S.pack "drop") ]) (const $ span_[][]) mbc,+     if markPossibilities v then div_ [style_ $ M.fromList [("font-size","0.8em")]] [text $ S.pack $ showColorPossibilities pc, br_[], text $ S.pack $ showNumberPossibilities pn] else span_[][]   ] where           pub = publicView pv-          myStyle = style_ $ M.fromList [ ("background-color",if markChops v && i `elem` map fst (concat $ take 1 $ chopss pub hl) then "#888888" else "#000000"),-                                          ("font-weight", if markObviouslyUseless v && isObviouslyUseless pub tup then "100" else "normal"),-                                          ("font-style",  if markObviouslyPlayable v && (if isNothing mbc then isObviouslyPlayable pv else isMoreObviouslyPlayable pub) tup then "oblique" else "normal")]+          myStyle | isNothing mbc = style_ $ M.fromList [ ("background-color", if warnDoubleDrop v && isDoubleDrop pv (result pub) chopSet ptup && i `elem` chopSet then "#880000" else+                                                                               if markChops v && i `elem` chopSet then "#888888" else "#000000"),+                                                          ("font-weight", if markObviouslyUseless v && isDefinitelyUseless pv tup ptup then "100" else "normal"),+                                                          ("font-style",  if markObviouslyPlayable v && isDefinitelyPlayable pv tup ptup then "oblique" else "normal")]+                  | otherwise     = style_ $ M.fromList [ ("background-color",if markChops v && i `elem` concat (take 1 $ obviousChopss pub hl ps) then "#888888" else "#000000"),+                                                          ("font-weight", if markObviouslyUseless v && isObviouslyUseless pub ptup then "100" else "normal"),+                                                          ("font-style",  if markObviouslyPlayable v && isObviouslyPlayable pub ptup then "oblique" else "normal")]+          chopSet = concat $ take 1 $ definiteChopss pv hl ps {- renderCards :: Verbosity -> PublicInfo -> [Maybe Card] -> [Marks] -> View Action renderCards v pub mbcs tups = table_ [style_ $ M.fromList [("border-color","#FFFFFF"),("border-width","medium")]] [

@@ -10,7 +10,7 @@ -- PVP summary:      +-+------- breaking API changes --                   | | +----- non-breaking API additions --                   | | | +--- code changes with no API change-version:             0.4.0.1+version:             0.5.0.0  -- A short (one-line) description of the package. synopsis:            Hanabi card game@@ -58,6 +58,9 @@   Default:     False Flag SNAP   Description: Use Snap instead of runServer.+  Default:     False+Flag WARP+  Description: Use Warp instead of runServer.   Default:     True FLAG TFRANDOM   Description: Use tf-random instead of random.@@ -69,6 +72,10 @@ FLAG TH   Description: Use template-haskell just for obtaining the compilation time.   Default:     True+Flag jsaddle+  Description: Build the client with JSaddle even when compiling with GHC.+               (Package miso must have been built with --flags="jsaddle".)+  Default:     False  library   -- Modules exported by the library.@@ -90,7 +97,7 @@   -- Base language which the package is written in.   default-language:    Haskell2010 -  if impl(ghcjs) || flag(server)+  if impl(ghcjs) || flag(jsaddle) || flag(server)     exposed-modules:     Game.Hanabi.VersionInfo     other-modules:       Game.Hanabi.Msg     -- cpp-options:      -DCABAL@@ -109,10 +116,14 @@     if flag(SNAP)       build-depends:       unix >=2.7 && <2.8, websockets-snap >=0.10 && <0.11, snap-server >=1.1 && <1.2, abstract-par >=0.3 && <0.4, monad-par >=0.3 && <0.4       cpp-options:         -DSNAP-  if impl(ghcjs)+    else+      if flag(WARP)+        build-depends:       wai-websockets, warp, wai, http-types+        cpp-options:         -DWARP+  if impl(ghcjs) || flag(jsaddle)       exposed-modules:     Game.Hanabi.Client       ghcjs-options:      -dedupe -O-      build-depends:      base >=4.12 && <4.13, jsaddle-warp >=0.9, aeson, miso, time+      build-depends:      base >=4.12 && <4.13, jsaddle-warp >=0.9, aeson, miso, time >=1.6       if flag(official)         cpp-options:  -DURI="ws://133.54.228.39:8720" @@ -135,16 +146,20 @@     if flag(SNAP)       build-depends:       unix >=2.7 && <2.8, websockets-snap >=0.10 && <0.11, snap-server >=1.1 && <1.2, abstract-par >=0.3 && <0.4, monad-par >=0.3 && <0.4       cpp-options:         -DSNAP+    else+      if flag(WARP)+        build-depends:       wai-websockets, warp, wai, http-types+        cpp-options:         -DWARP  executable client   main-is:       client.hs   other-modules: Game.Hanabi.Msg, Game.Hanabi.Client, Game.Hanabi.VersionInfo, Game.Hanabi.Strategies.SimpleStrategy-  if !impl(ghcjs)+  if !impl(ghcjs) && !flag(jsaddle)     buildable: False   else     ghcjs-options:      -dedupe -O     cpp-options:        -DCABAL-    build-depends:      base >=4.12 && <4.13, containers >=0.5, random >=1.1, jsaddle-warp >=0.9, aeson, miso, time, hanabi-dealer+    build-depends:      base >=4.12 && <4.13, containers >=0.5, random >=1.1, jsaddle-warp >=0.9, aeson, miso, time >=1.6, hanabi-dealer     default-language:   Haskell2010     if flag(official)       cpp-options:  -DURI="ws://133.54.228.39:8720"