Rock Paper Scissors: Interactive

import qualified System.Random as R
import Control.Applicative ((<*>), (<$>), pure)
import Control.Monad.State (State, state, evalState)
import Control.Arrow (first)

data RPS = Rock | Paper | Scissors deriving (Eq, Show, Read)
type Score = (Int, Int)

instance R.Random RPS where
    random = first pick . R.randomR (0,2)
        where pick :: Int -> RPS
              pick 0 = Rock
              pick 1 = Paper
              pick 2 = Scissors
    randomR = error "Unsupported data type"

newGame :: Score
newGame = (0,0)

beats :: RPS -> RPS -> Bool
beats Rock Scissors  = True
beats Paper Rock     = True
beats Scissors Paper = True
beats _ _ = False

play :: RPS -> RPS -> Score -> Score
play ca cb (sa,sb)
    | ca `beats` cb = (sa+1, sb)
    | cb `beats` ca  = (sa, sb+1)
    | otherwise     = (sa, sb)

getChoice :: IO RPS
getChoice = fmap read getLine

getRandom :: IO RPS
getRandom = do c <- R.randomIO
               putStrLn $ "PC picked " ++ show c
               return c

playRound :: Score -> IO Score
playRound s = play <$> getChoice <*> getRandom <*> pure s

playLoop :: Score -> IO Score
playLoop s = do r <- playRound s
                print r
                playLoop r

main = playLoop newGame