import List

type Choice = Int
type Memory = (Int,[Choice],[([Choice],[Int])])

emptyMemory :: Int -> Memory
emptyMemory depth = (depth,[],[])

likelyChoice :: Memory -> Maybe Choice
likelyChoice (_,last,prev)
  = lookup last prev >>=
    return . fst . head . sortBy (\ (_,x) (_,y) -> compare y x) . zip [0..]

remember :: Memory -> Choice -> Memory
remember (depth,last,prev) you
  = (depth,take depth (you:last),update prev last you)
 where
  update [] l y = [(l,incAt y [0,0,0])]
  update ((a,b):xs) l y
    = if l==a then (a,incAt y b) : xs else (a,b) : update xs l y

  incAt 0 (x:xs) = (x+1:xs)
  incAt (n+1) (x:xs) = x : incAt n xs

data Score = Score Int Int

instance Show Score where
  show (Score me you) = "Du: " ++ show you ++ ", ich: " ++ show me

newScore :: Score
newScore = Score 0 0

updateScore :: Score -> Choice -> Choice -> Score
updateScore (Score my your) me you
  = case winner me you of
     0 -> Score my your
     1 -> Score (my+1) your
     2 -> Score my (your+1)

winner :: Choice -> Choice -> Int
winner x y = (y-x) `mod` 3 -- 0: draw, 1: x wins, 2: y wins


main = loop (emptyMemory 2) newScore

loop mem scr = do
  let me = nextChoice mem
  print scr
  putStr "Stein [1], Schere [2], oder Papier [3]? "
  getLine >>= maybe (putStrLn "tschau!") (again me) . readChoice
 where
  again me you = do
    putStrLn ("Ich nehme " ++ (["Stein","Schere","Papier"]!!me))
    loop (remember mem you) (updateScore scr me you)

nextChoice :: Memory -> Choice
nextChoice mem = maybe 0 reply (likelyChoice mem)
 where
  reply n = (n-1) `mod` 3 

readChoice :: String -> Maybe Choice
readChoice "1" = Just 0
readChoice "2" = Just 1
readChoice "3" = Just 2
readChoice  _  = Nothing