card-game.hs

import Text.Printf
import Data.Foldable
import Control.Monad

-- The colors are “True” and “False”, the suits are 0,1,2,3

main = do
  -- Just naming the color of neighbor's card will fail in both games
  check1 $ \i n0 n1 -> case i of
    0 -> n1
    1 -> n0
  check2 $ \i n0 n1 n2 n3 -> case i of
    0 -> n1
    1 -> n2
    2 -> n3
    3 -> n0

{-
Give this function a guessing rule of form

    \i n0 n1 -> <your guess>

where 'i' is player's number (0 or 1), n0 is first player's card, and n1 is
second player's card.

If your rule tries to look at its own card, it will fail.
-}
check1 :: (Int -> Bool -> Bool -> Bool) -> IO ()
check1 guess = do
  let bad = do
        n0 <- [True, False]
        n1 <- [True, False]
        let n0' = guess 0 (err 0) n1
            n1' = guess 1 n0 (err 1)
        guard (and (zipWith (/=) [n0,n1] [n0',n1']))
        return ([n0,n1],[n0',n1'])
  if null bad
    then putStrLn "OK"
    else putStrLn "you didn't guess in some cases"
  for_ bad $ \(x,y) ->
    printf "for %s you guessed %s\n" (show y) (show x)
  putStrLn ""

check2 :: (Int -> Int -> Int -> Int -> Int -> Int) -> IO ()
check2 guess = do
  let bad = do
        ns <- replicateM 4 [0..3]
        let ns' = do
              i <- [0..3]
              return $ guess i
                (if i==0 then err 0 else ns!!0)
                (if i==1 then err 1 else ns!!1)
                (if i==2 then err 2 else ns!!2)
                (if i==3 then err 3 else ns!!3)
        guard (and (zipWith (/=) ns ns'))
        return (ns,ns')
  if null bad
    then putStrLn "OK"
    else putStrLn "you didn't guess in some cases"
  for_ bad $ \(x,y) ->
    printf "for %s you guessed %s\n" (show y) (show x)
  putStrLn ""

err i = error ("can't look at #" ++ show i)