skat/src/Skat/AI/Base.hs

{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE TupleSections #-}

module Skat.AI.Base where

import System.Random (Random)
import qualified System.Random as Rand
import Control.Monad.State
import Control.Exception (assert)
import Control.Monad.Fail
import Data.Ord
import Text.Read (readMaybe)
import Data.List (maximumBy, sortBy)
import Debug.Trace

class (Ord v, Eq v) => Value v where
    invert :: v -> v
    win :: v
    loss :: v
    tie :: v
    tonum :: v -> Float
    tonum v
      | v == win  = 1.0
      | v == loss = 0.0
      | v == tie  = 0.5

class Player p where
    maxing :: p -> Bool

class (Traversable l, Monad m, Value v, Player p, Eq t) => MonadGame t l v p m | m -> t, m -> p, m -> v, m -> l where
    currentPlayer :: m p
    turns :: m (l t)
    play :: t -> m ()
    simulate :: t -> m a -> m a
    evaluate :: m v
    over :: m Bool

class (MonadIO m, Show t, Show v, Show p, MonadGame t l v p m) => PlayableGame t l v p m | m -> t, m -> p, m -> v where
    showTurns :: m ()
    showBoard :: m ()
    askTurn :: m (Maybe t)
    showTurn :: t -> m ()
    winner :: m (Maybe p)

class Choose t m | m -> t where 
    choose :: m t

class MonadRandom m where
    random :: Random a => m a
    chooser :: [a] -> m a

instance MonadRandom IO where
    random = Rand.randomIO
    chooser [] = error "chooser: empty list"
    chooser os = (os!!) <$> Rand.randomRIO (0, length os -1)

instance MonadRandom (State Rand.StdGen) where
    random = do
        gen <- get
        let (a, gen') = Rand.random gen
        put gen'
        return a
    chooser [] = error "chooser: empty list"
    chooser os = do
        gen <- get
        let (a, gen') = Rand.randomR (0, length os -1) gen
        put gen'
        return (os !! a)