hcheckers-0.1.0.2: src/Main.hs

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ViewPatterns #-}
module Main where

import Control.Monad
import Control.Monad.Reader
import Control.Concurrent.STM
import Data.Default
import Data.Maybe
import Data.List
import qualified Data.Map as M
import qualified Data.Text as T
import qualified Data.Text.IO as TIO
import qualified Data.ByteString.Lazy.Char8 as C8
import qualified Data.Aeson as Aeson
import System.Log.Heavy
import Options.Applicative
import Text.Printf
import System.Random

import Core.Types hiding (timed)
import AI
import AI.AlphaBeta.Types
import AI.AlphaBeta.Persistent (loadAiData')
import Rest.Common (runRestServer)
import Rest.Game (restServer)
import Rest.Battle (restServer)
import Core.Checkers
import Core.CmdLine
import Core.Supervisor (withRules)
import Core.Parallel
import Core.Monitoring

import Learn
import Battle
import Rules.Russian
-- import Rules.Spancirety

  -- let stdout = LoggingSettings $ filtering defaultLogFilter defStdoutSettings
      -- debug = LoggingSettings $ Filtering (\m -> lmLevel m == trace_level) ((defFileSettings "trace.log") {lsFormat = "{time} {source} [{thread}]: {message}\n"})
      -- settings = LoggingSettings $ ParallelLogSettings [stdout, debug]

main :: IO ()
main = do
  cmd <- execParser parserInfo
  case cmdSpecial cmd of
    Nothing ->
      withCheckers cmd $ do
          logLevel <- asks (gcLogLevel . csConfig)
          host <- asks (T.unpack . gcHost . csConfig)
          port <- asks (gcPort . csConfig)
          bsConfig <- asks (gcBattleServerConfig . csConfig)
          let fltr = [([], logLevel)]
          withLogContext (LogContextFrame [] (include fltr)) $ do
              if fromMaybe False (cmdBattleServer cmd)
                then if bsEnable bsConfig
                       then runRestServer (T.unpack $ bsHost bsConfig) (bsPort bsConfig) Rest.Battle.restServer
                       else fail "Battle server is not enabled in config"
                else runRestServer host port Rest.Game.restServer
                
    Just str -> special cmd (words str)

special :: CmdLine -> [String] -> IO ()
special cmd args =
  case args of
    ["learn", path] -> do
      let rules = russian
          eval = ai
          params = def {
                     abDepth = 4
                   , abCombinationDepth = 9
                   }
          ai = AlphaBeta params rules (dfltEvaluator rules)
      withCheckers cmd $
          withLogContext (LogContextFrame [] (include defaultLogFilter)) $
            learnPdn ai path

    ["battle", rulesName, path1, path2] -> do
      withRules rulesName $ \rules -> do
        ai1 <- loadAi "default" rules path1
        ai2 <- loadAi "default" rules path2
        withCheckers cmd $
            withLogContext (LogContextFrame [] (include defaultLogFilter)) $ do
              runBattleLocal (SomeRules rules) (1,SomeAi ai1) (2,SomeAi ai2) "battle.pdn"
              return ()

    ["battle-remote", host, rulesName, path1, path2] -> do
      withRules rulesName $ \rules -> do
        ai1 <- loadAi "default" rules path1
        ai2 <- loadAi "default" rules path2
        withCheckers cmd $
            withLogContext (LogContextFrame [] (include defaultLogFilter)) $ do
              rs <- runBattleRemote (T.pack host) (SomeRules rules) (1,SomeAi ai1) (2,SomeAi ai2) "battle.pdn"
              liftIO $ putStrLn $ "Remote: " ++ show rs
              return ()

    ["match", rulesName, ns, path1, path2] -> do
      withRules rulesName $ \rules -> do
        let n = read ns
        ai1 <- loadAi "default" rules path1
        ai2 <- loadAi "default" rules path2
        putStrLn $ "AI1: " ++ show ai1
        putStrLn $ "AI2: " ++ show ai2
        withCheckers cmd $
            withLogContext (LogContextFrame [] (include defaultLogFilter)) $ do
              runMatch runBattleLocal (SomeRules rules) (1, SomeAi ai1) (2, SomeAi ai2) n
              return ()

    ("tournament": matches : games : paths) -> do 
      let rules = russian
          nMatches = read matches
          nGames = read games
      ais <- forM paths $ \path -> loadAi "default" rules path
      withCheckers cmd $
          withLogContext (LogContextFrame [] (include defaultLogFilter)) $ do
            runTournament (dumbMatchRunner runBattleLocal) rules ais nMatches nGames
            return ()

    ["genetics", yamlPath] -> do
      withCheckers cmd $ do
          withLogContext (LogContextFrame [] (include defaultLogFilter)) $ do
            result <- runGeneticsJ yamlPath
            forM_ result $ \(SomeAi ai) -> liftIO $ C8.putStrLn $ Aeson.encode ai
            return ()

    ["generate", ns, deltas, path] -> do
      let n = read ns
          delta = read deltas
      generateAiVariations n delta path

    ["dump", path] -> do
      withCheckers cmd $ do
        let rules = russian
        (vec, bmap) <- loadAiData' path
        liftIO $ printf "Evaluator: %s\n" (show vec)
        forM_ (M.assocs bmap) $ \(bHash, item) -> do
            liftIO $ printf "Hash: %d => %s\n" bHash (show item)