module Game.Chess.UCI (
UCIException(..)
, Engine, BestMove, name, author
, start, start'
, Option(..), options, getOption, setOptionSpinButton, setOptionString
, isready
, currentPosition, setPosition, addPly, replacePly
, Info(..), Score(..), Bounds(..)
, search, searching
, SearchParam
, searchmoves, ponder, timeleft, timeincrement, movestogo, movetime, nodes, depth, infinite
, ponderhit
, stop
, quit, quit'
) where
import Control.Applicative
import Control.Concurrent
import Control.Concurrent.STM hiding (check)
import Control.Exception
import Control.Monad
import Control.Monad.IO.Class
import Data.Attoparsec.Combinator
import Data.Attoparsec.ByteString.Char8
import Data.ByteString.Builder
import Data.ByteString.Char8 (ByteString)
import qualified Data.ByteString.Char8 as BS
import Data.Foldable
import Data.Functor
import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as HashMap
import Data.IORef
import Data.Ix
import Data.List
import Data.String (IsString(..))
import Game.Chess
import Numeric.Natural
import System.Exit (ExitCode)
import System.IO
import System.Process
import Time.Rational
import Time.Units
type BestMove = Maybe (Ply, Maybe Ply)
data Engine = Engine {
Engine -> Handle
inH :: Handle
, Engine -> Handle
outH :: Handle
, Engine -> ProcessHandle
procH :: ProcessHandle
, Engine -> String -> IO ()
outputStrLn :: String -> IO ()
, Engine -> Maybe ThreadId
infoThread :: Maybe ThreadId
, Engine -> Maybe ByteString
name :: Maybe ByteString
, Engine -> Maybe ByteString
author :: Maybe ByteString
, Engine -> HashMap ByteString Option
options :: HashMap ByteString Option
, Engine -> MVar ()
isReady :: MVar ()
, Engine -> IORef Bool
isSearching :: IORef Bool
, Engine -> TChan [Info]
infoChan :: TChan [Info]
, Engine -> TChan BestMove
bestMoveChan :: TChan BestMove
, Engine -> IORef (Position, [Ply])
game :: IORef (Position, [Ply])
}
setPosition :: MonadIO m
=> Engine -> Position
-> m (Position, [Ply])
setPosition :: Engine -> Position -> m (Position, [Ply])
setPosition e :: Engine
e@Engine{IORef (Position, [Ply])
game :: IORef (Position, [Ply])
game :: Engine -> IORef (Position, [Ply])
game} Position
p = IO (Position, [Ply]) -> m (Position, [Ply])
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Position, [Ply]) -> m (Position, [Ply]))
-> IO (Position, [Ply]) -> m (Position, [Ply])
forall a b. (a -> b) -> a -> b
$ do
(Position, [Ply])
oldGame <- IORef (Position, [Ply])
-> ((Position, [Ply]) -> ((Position, [Ply]), (Position, [Ply])))
-> IO (Position, [Ply])
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' IORef (Position, [Ply])
game ((Position
p, []),)
Engine -> IO ()
sendPosition Engine
e
(Position, [Ply]) -> IO (Position, [Ply])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Position, [Ply])
oldGame
data UCIException = IllegalMove Ply deriving Int -> UCIException -> ShowS
[UCIException] -> ShowS
UCIException -> String
(Int -> UCIException -> ShowS)
-> (UCIException -> String)
-> ([UCIException] -> ShowS)
-> Show UCIException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UCIException] -> ShowS
$cshowList :: [UCIException] -> ShowS
show :: UCIException -> String
$cshow :: UCIException -> String
showsPrec :: Int -> UCIException -> ShowS
$cshowsPrec :: Int -> UCIException -> ShowS
Show
instance Exception UCIException
data Command = Name !ByteString
| Author !ByteString
| Option !ByteString !Option
| UCIOk
| ReadyOK
| Info [Info]
| BestMove !BestMove
deriving (Int -> Command -> ShowS
[Command] -> ShowS
Command -> String
(Int -> Command -> ShowS)
-> (Command -> String) -> ([Command] -> ShowS) -> Show Command
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Command] -> ShowS
$cshowList :: [Command] -> ShowS
show :: Command -> String
$cshow :: Command -> String
showsPrec :: Int -> Command -> ShowS
$cshowsPrec :: Int -> Command -> ShowS
Show)
data Info = PV [Ply]
| Depth Int
| SelDepth Int
| Elapsed (Time Millisecond)
| MultiPV Int
| Score Score (Maybe Bounds)
| Nodes Int
| NPS Int
| TBHits Int
| HashFull Int
| CurrMove Ply
| CurrMoveNumber Int
| String ByteString
deriving (Info -> Info -> Bool
(Info -> Info -> Bool) -> (Info -> Info -> Bool) -> Eq Info
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Info -> Info -> Bool
$c/= :: Info -> Info -> Bool
== :: Info -> Info -> Bool
$c== :: Info -> Info -> Bool
Eq, Int -> Info -> ShowS
[Info] -> ShowS
Info -> String
(Int -> Info -> ShowS)
-> (Info -> String) -> ([Info] -> ShowS) -> Show Info
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Info] -> ShowS
$cshowList :: [Info] -> ShowS
show :: Info -> String
$cshow :: Info -> String
showsPrec :: Int -> Info -> ShowS
$cshowsPrec :: Int -> Info -> ShowS
Show)
data Score = CentiPawns Int
| MateIn Int
deriving (Score -> Score -> Bool
(Score -> Score -> Bool) -> (Score -> Score -> Bool) -> Eq Score
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Score -> Score -> Bool
$c/= :: Score -> Score -> Bool
== :: Score -> Score -> Bool
$c== :: Score -> Score -> Bool
Eq, Eq Score
Eq Score
-> (Score -> Score -> Ordering)
-> (Score -> Score -> Bool)
-> (Score -> Score -> Bool)
-> (Score -> Score -> Bool)
-> (Score -> Score -> Bool)
-> (Score -> Score -> Score)
-> (Score -> Score -> Score)
-> Ord Score
Score -> Score -> Bool
Score -> Score -> Ordering
Score -> Score -> Score
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Score -> Score -> Score
$cmin :: Score -> Score -> Score
max :: Score -> Score -> Score
$cmax :: Score -> Score -> Score
>= :: Score -> Score -> Bool
$c>= :: Score -> Score -> Bool
> :: Score -> Score -> Bool
$c> :: Score -> Score -> Bool
<= :: Score -> Score -> Bool
$c<= :: Score -> Score -> Bool
< :: Score -> Score -> Bool
$c< :: Score -> Score -> Bool
compare :: Score -> Score -> Ordering
$ccompare :: Score -> Score -> Ordering
$cp1Ord :: Eq Score
Ord, Int -> Score -> ShowS
[Score] -> ShowS
Score -> String
(Int -> Score -> ShowS)
-> (Score -> String) -> ([Score] -> ShowS) -> Show Score
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Score] -> ShowS
$cshowList :: [Score] -> ShowS
show :: Score -> String
$cshow :: Score -> String
showsPrec :: Int -> Score -> ShowS
$cshowsPrec :: Int -> Score -> ShowS
Show)
data Bounds = UpperBound | LowerBound deriving (Bounds -> Bounds -> Bool
(Bounds -> Bounds -> Bool)
-> (Bounds -> Bounds -> Bool) -> Eq Bounds
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Bounds -> Bounds -> Bool
$c/= :: Bounds -> Bounds -> Bool
== :: Bounds -> Bounds -> Bool
$c== :: Bounds -> Bounds -> Bool
Eq, Int -> Bounds -> ShowS
[Bounds] -> ShowS
Bounds -> String
(Int -> Bounds -> ShowS)
-> (Bounds -> String) -> ([Bounds] -> ShowS) -> Show Bounds
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Bounds] -> ShowS
$cshowList :: [Bounds] -> ShowS
show :: Bounds -> String
$cshow :: Bounds -> String
showsPrec :: Int -> Bounds -> ShowS
$cshowsPrec :: Int -> Bounds -> ShowS
Show)
data Option = CheckBox Bool
| ComboBox { Option -> ByteString
comboBoxValue :: ByteString, Option -> [ByteString]
comboBoxValues :: [ByteString] }
| SpinButton { Option -> Int
spinButtonValue, Option -> Int
spinButtonMinBound, Option -> Int
spinButtonMaxBound :: Int }
| OString ByteString
| Button
deriving (Option -> Option -> Bool
(Option -> Option -> Bool)
-> (Option -> Option -> Bool) -> Eq Option
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Option -> Option -> Bool
$c/= :: Option -> Option -> Bool
== :: Option -> Option -> Bool
$c== :: Option -> Option -> Bool
Eq, Int -> Option -> ShowS
[Option] -> ShowS
Option -> String
(Int -> Option -> ShowS)
-> (Option -> String) -> ([Option] -> ShowS) -> Show Option
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Option] -> ShowS
$cshowList :: [Option] -> ShowS
show :: Option -> String
$cshow :: Option -> String
showsPrec :: Int -> Option -> ShowS
$cshowsPrec :: Int -> Option -> ShowS
Show)
instance IsString Option where
fromString :: String -> Option
fromString = ByteString -> Option
OString (ByteString -> Option)
-> (String -> ByteString) -> String -> Option
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
BS.pack
command :: Position -> Parser Command
command :: Position -> Parser Command
command Position
pos = Parser ()
skipSpace Parser () -> Parser Command -> Parser Command
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> [Parser Command] -> Parser Command
forall (f :: * -> *) a. Alternative f => [f a] -> f a
choice
[ Parser ByteString ByteString
"id" Parser ByteString ByteString -> Parser Command -> Parser Command
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
`kv` Parser Command
name
, Parser ByteString ByteString
"id" Parser ByteString ByteString -> Parser Command -> Parser Command
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
`kv` Parser Command
author
, Parser ByteString ByteString
"option" Parser ByteString ByteString -> Parser Command -> Parser Command
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
`kv` Parser Command
opt
, Parser ByteString ByteString
"uciok" Parser ByteString ByteString -> Command -> Parser Command
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Command
UCIOk
, Parser ByteString ByteString
"readyok" Parser ByteString ByteString -> Command -> Parser Command
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Command
ReadyOK
, Parser ByteString ByteString
"info" Parser ByteString ByteString -> Parser Command -> Parser Command
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
`kv` ([Info] -> Command) -> Parser ByteString [Info] -> Parser Command
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Info] -> Command
Info (Parser ByteString Info -> Parser () -> Parser ByteString [Info]
forall (f :: * -> *) a s. Alternative f => f a -> f s -> f [a]
sepBy1 Parser ByteString Info
infoItem Parser ()
skipSpace)
, Parser ByteString ByteString
"bestmove" Parser ByteString ByteString -> Parser Command -> Parser Command
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
`kv` (Parser ByteString ByteString
"(none)" Parser ByteString ByteString -> Command -> Parser Command
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> BestMove -> Command
BestMove BestMove
forall a. Maybe a
Nothing Parser Command -> Parser Command -> Parser Command
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Command
bestmove)
] Parser Command -> Parser () -> Parser Command
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
skipSpace
where
name :: Parser Command
name = ByteString -> Command
Name (ByteString -> Command)
-> Parser ByteString ByteString -> Parser Command
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString ByteString
-> Parser ByteString ByteString -> Parser ByteString ByteString
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
kv Parser ByteString ByteString
"name" Parser ByteString ByteString
takeByteString
author :: Parser Command
author = ByteString -> Command
Author (ByteString -> Command)
-> Parser ByteString ByteString -> Parser Command
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString ByteString
-> Parser ByteString ByteString -> Parser ByteString ByteString
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
kv Parser ByteString ByteString
"author" Parser ByteString ByteString
takeByteString
opt :: Parser Command
opt = do
Parser ByteString ByteString -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void Parser ByteString ByteString
"name"
Parser ()
skipSpace
ByteString
optName <- String -> ByteString
BS.pack (String -> ByteString)
-> Parser ByteString String -> Parser ByteString ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Char
-> Parser ByteString ByteString -> Parser ByteString String
forall (f :: * -> *) a s. Alternative f => f a -> f s -> f [a]
manyTill Parser ByteString Char
anyChar (Parser ()
skipSpace Parser ()
-> Parser ByteString ByteString -> Parser ByteString ByteString
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString ByteString
"type")
Parser ()
skipSpace
Option
optValue <- Parser ByteString Option
spin Parser ByteString Option
-> Parser ByteString Option -> Parser ByteString Option
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ByteString Option
check Parser ByteString Option
-> Parser ByteString Option -> Parser ByteString Option
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ByteString Option
combo Parser ByteString Option
-> Parser ByteString Option -> Parser ByteString Option
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ByteString Option
str Parser ByteString Option
-> Parser ByteString Option -> Parser ByteString Option
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ByteString Option
button
Command -> Parser Command
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Command -> Parser Command) -> Command -> Parser Command
forall a b. (a -> b) -> a -> b
$ ByteString -> Option -> Command
Option ByteString
optName Option
optValue
check :: Parser ByteString Option
check =
(Bool -> Option)
-> Parser ByteString Bool -> Parser ByteString Option
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> Option
CheckBox (Parser ByteString Bool -> Parser ByteString Option)
-> Parser ByteString Bool -> Parser ByteString Option
forall a b. (a -> b) -> a -> b
$ Parser ByteString ByteString
"check" Parser ByteString ByteString -> Parser () -> Parser ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
skipSpace Parser ()
-> Parser ByteString ByteString -> Parser ByteString ByteString
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString ByteString
"default" Parser ByteString ByteString -> Parser () -> Parser ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
skipSpace Parser () -> Parser ByteString Bool -> Parser ByteString Bool
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>
(Parser ByteString ByteString
"false" Parser ByteString ByteString -> Bool -> Parser ByteString Bool
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Bool
False Parser ByteString Bool
-> Parser ByteString Bool -> Parser ByteString Bool
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ByteString ByteString
"true" Parser ByteString ByteString -> Bool -> Parser ByteString Bool
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Bool
True)
spin :: Parser ByteString Option
spin = do
Parser ByteString ByteString -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void Parser ByteString ByteString
"spin"
Parser ()
skipSpace
Int
value <- Parser ByteString ByteString
"default" Parser ByteString ByteString -> Parser () -> Parser ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
skipSpace Parser () -> Parser ByteString Int -> Parser ByteString Int
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString Int -> Parser ByteString Int
forall a. Num a => Parser a -> Parser a
signed Parser ByteString Int
forall a. Integral a => Parser a
decimal Parser ByteString Int -> Parser () -> Parser ByteString Int
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
skipSpace
Int
minValue <- Parser ByteString ByteString
"min" Parser ByteString ByteString -> Parser () -> Parser ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
skipSpace Parser () -> Parser ByteString Int -> Parser ByteString Int
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString Int -> Parser ByteString Int
forall a. Num a => Parser a -> Parser a
signed Parser ByteString Int
forall a. Integral a => Parser a
decimal Parser ByteString Int -> Parser () -> Parser ByteString Int
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
skipSpace
Int
maxValue <- Parser ByteString ByteString
"max" Parser ByteString ByteString -> Parser () -> Parser ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
skipSpace Parser () -> Parser ByteString Int -> Parser ByteString Int
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString Int -> Parser ByteString Int
forall a. Num a => Parser a -> Parser a
signed Parser ByteString Int
forall a. Integral a => Parser a
decimal
Option -> Parser ByteString Option
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Option -> Parser ByteString Option)
-> Option -> Parser ByteString Option
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int -> Option
SpinButton Int
value Int
minValue Int
maxValue
combo :: Parser ByteString Option
combo = do
Parser ByteString ByteString -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void Parser ByteString ByteString
"combo"
Parser ()
skipSpace
ByteString
def <- (String -> ByteString)
-> Parser ByteString String -> Parser ByteString ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> ByteString
BS.pack (Parser ByteString String -> Parser ByteString ByteString)
-> Parser ByteString String -> Parser ByteString ByteString
forall a b. (a -> b) -> a -> b
$ Parser ByteString ByteString
"default" Parser ByteString ByteString -> Parser () -> Parser ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
skipSpace Parser () -> Parser ByteString String -> Parser ByteString String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString Char -> Parser () -> Parser ByteString String
forall (f :: * -> *) a s. Alternative f => f a -> f s -> f [a]
manyTill Parser ByteString Char
anyChar Parser ()
var
([String]
vars, ByteString
lastVar) <- (,) ([String] -> ByteString -> ([String], ByteString))
-> Parser ByteString [String]
-> Parser ByteString (ByteString -> ([String], ByteString))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString String -> Parser ByteString [String]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (Parser ByteString Char -> Parser () -> Parser ByteString String
forall (f :: * -> *) a s. Alternative f => f a -> f s -> f [a]
manyTill Parser ByteString Char
anyChar Parser ()
var)
Parser ByteString (ByteString -> ([String], ByteString))
-> Parser ByteString ByteString
-> Parser ByteString ([String], ByteString)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString ByteString
takeByteString
Option -> Parser ByteString Option
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Option -> Parser ByteString Option)
-> Option -> Parser ByteString Option
forall a b. (a -> b) -> a -> b
$ ByteString -> [ByteString] -> Option
ComboBox ByteString
def ((String -> ByteString) -> [String] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map String -> ByteString
BS.pack [String]
vars [ByteString] -> [ByteString] -> [ByteString]
forall a. Semigroup a => a -> a -> a
<> [ByteString
lastVar])
var :: Parser ()
var = Parser ()
skipSpace Parser ()
-> Parser ByteString ByteString -> Parser ByteString ByteString
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString ByteString
"var" Parser ByteString ByteString -> Parser () -> Parser ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
skipSpace
str :: Parser ByteString Option
str = (ByteString -> Option)
-> Parser ByteString ByteString -> Parser ByteString Option
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> Option
OString (Parser ByteString ByteString -> Parser ByteString Option)
-> Parser ByteString ByteString -> Parser ByteString Option
forall a b. (a -> b) -> a -> b
$
Parser ByteString ByteString
"string" Parser ByteString ByteString -> Parser () -> Parser ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
skipSpace Parser ()
-> Parser ByteString ByteString -> Parser ByteString ByteString
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString ByteString
"default" Parser ByteString ByteString -> Parser () -> Parser ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
skipSpace Parser ()
-> Parser ByteString ByteString -> Parser ByteString ByteString
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString ByteString
takeByteString
button :: Parser ByteString Option
button = Parser ByteString ByteString
"button" Parser ByteString ByteString -> Option -> Parser ByteString Option
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Option
Button
infoItem :: Parser ByteString Info
infoItem = Int -> Info
Depth (Int -> Info) -> Parser ByteString Int -> Parser ByteString Info
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString ByteString
-> Parser ByteString Int -> Parser ByteString Int
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
kv Parser ByteString ByteString
"depth" Parser ByteString Int
forall a. Integral a => Parser a
decimal
Parser ByteString Info
-> Parser ByteString Info -> Parser ByteString Info
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Int -> Info
SelDepth (Int -> Info) -> Parser ByteString Int -> Parser ByteString Info
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString ByteString
-> Parser ByteString Int -> Parser ByteString Int
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
kv Parser ByteString ByteString
"seldepth" Parser ByteString Int
forall a. Integral a => Parser a
decimal
Parser ByteString Info
-> Parser ByteString Info -> Parser ByteString Info
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Int -> Info
MultiPV (Int -> Info) -> Parser ByteString Int -> Parser ByteString Info
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString ByteString
-> Parser ByteString Int -> Parser ByteString Int
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
kv Parser ByteString ByteString
"multipv" Parser ByteString Int
forall a. Integral a => Parser a
decimal
Parser ByteString Info
-> Parser ByteString Info -> Parser ByteString Info
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ByteString ByteString
-> Parser ByteString Info -> Parser ByteString Info
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
kv Parser ByteString ByteString
"score" Parser ByteString Info
score
Parser ByteString Info
-> Parser ByteString Info -> Parser ByteString Info
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Int -> Info
Nodes (Int -> Info) -> Parser ByteString Int -> Parser ByteString Info
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString ByteString
-> Parser ByteString Int -> Parser ByteString Int
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
kv Parser ByteString ByteString
"nodes" Parser ByteString Int
forall a. Integral a => Parser a
decimal
Parser ByteString Info
-> Parser ByteString Info -> Parser ByteString Info
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Int -> Info
NPS (Int -> Info) -> Parser ByteString Int -> Parser ByteString Info
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString ByteString
-> Parser ByteString Int -> Parser ByteString Int
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
kv Parser ByteString ByteString
"nps" Parser ByteString Int
forall a. Integral a => Parser a
decimal
Parser ByteString Info
-> Parser ByteString Info -> Parser ByteString Info
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Int -> Info
HashFull (Int -> Info) -> Parser ByteString Int -> Parser ByteString Info
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString ByteString
-> Parser ByteString Int -> Parser ByteString Int
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
kv Parser ByteString ByteString
"hashfull" Parser ByteString Int
forall a. Integral a => Parser a
decimal
Parser ByteString Info
-> Parser ByteString Info -> Parser ByteString Info
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Int -> Info
TBHits (Int -> Info) -> Parser ByteString Int -> Parser ByteString Info
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString ByteString
-> Parser ByteString Int -> Parser ByteString Int
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
kv Parser ByteString ByteString
"tbhits" Parser ByteString Int
forall a. Integral a => Parser a
decimal
Parser ByteString Info
-> Parser ByteString Info -> Parser ByteString Info
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Time (1 :% 1000) -> Info
Time Millisecond -> Info
Elapsed (Time (1 :% 1000) -> Info)
-> (Integer -> Time (1 :% 1000)) -> Integer -> Info
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RatioNat -> Time (1 :% 1000)
RatioNat -> Time Millisecond
ms (RatioNat -> Time (1 :% 1000))
-> (Integer -> RatioNat) -> Integer -> Time (1 :% 1000)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> RatioNat
forall a. Num a => Integer -> a
fromInteger (Integer -> Info)
-> Parser ByteString Integer -> Parser ByteString Info
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString ByteString
-> Parser ByteString Integer -> Parser ByteString Integer
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
kv Parser ByteString ByteString
"time" Parser ByteString Integer
forall a. Integral a => Parser a
decimal
Parser ByteString Info
-> Parser ByteString Info -> Parser ByteString Info
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ByteString ByteString
-> Parser ByteString Info -> Parser ByteString Info
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
kv Parser ByteString ByteString
"pv" Parser ByteString Info
pv
Parser ByteString Info
-> Parser ByteString Info -> Parser ByteString Info
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ByteString ByteString
-> Parser ByteString Info -> Parser ByteString Info
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
kv Parser ByteString ByteString
"currmove" Parser ByteString Info
currmove
Parser ByteString Info
-> Parser ByteString Info -> Parser ByteString Info
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Int -> Info
CurrMoveNumber (Int -> Info) -> Parser ByteString Int -> Parser ByteString Info
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString ByteString
-> Parser ByteString Int -> Parser ByteString Int
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
kv Parser ByteString ByteString
"currmovenumber" Parser ByteString Int
forall a. Integral a => Parser a
decimal
Parser ByteString Info
-> Parser ByteString Info -> Parser ByteString Info
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ByteString -> Info
String (ByteString -> Info)
-> Parser ByteString ByteString -> Parser ByteString Info
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString ByteString
-> Parser ByteString ByteString -> Parser ByteString ByteString
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
kv Parser ByteString ByteString
"string" Parser ByteString ByteString
takeByteString
score :: Parser ByteString Info
score = do
Score
s <- Parser ByteString ByteString
-> Parser ByteString Score -> Parser ByteString Score
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
kv Parser ByteString ByteString
"cp" (Int -> Score
CentiPawns (Int -> Score) -> Parser ByteString Int -> Parser ByteString Score
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Int -> Parser ByteString Int
forall a. Num a => Parser a -> Parser a
signed Parser ByteString Int
forall a. Integral a => Parser a
decimal)
Parser ByteString Score
-> Parser ByteString Score -> Parser ByteString Score
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ByteString ByteString
-> Parser ByteString Score -> Parser ByteString Score
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
kv Parser ByteString ByteString
"mate" (Int -> Score
MateIn (Int -> Score) -> Parser ByteString Int -> Parser ByteString Score
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Int -> Parser ByteString Int
forall a. Num a => Parser a -> Parser a
signed Parser ByteString Int
forall a. Integral a => Parser a
decimal)
Maybe Bounds
b <- Parser ByteString Bounds -> Parser ByteString (Maybe Bounds)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser ByteString Bounds -> Parser ByteString (Maybe Bounds))
-> Parser ByteString Bounds -> Parser ByteString (Maybe Bounds)
forall a b. (a -> b) -> a -> b
$ Parser ()
skipSpace Parser () -> Parser ByteString Bounds -> Parser ByteString Bounds
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ( Bounds
UpperBound Bounds -> Parser ByteString ByteString -> Parser ByteString Bounds
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser ByteString ByteString
"upperbound"
Parser ByteString Bounds
-> Parser ByteString Bounds -> Parser ByteString Bounds
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Bounds
LowerBound Bounds -> Parser ByteString ByteString -> Parser ByteString Bounds
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser ByteString ByteString
"lowerbound"
)
Info -> Parser ByteString Info
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Info -> Parser ByteString Info) -> Info -> Parser ByteString Info
forall a b. (a -> b) -> a -> b
$ Score -> Maybe Bounds -> Info
Score Score
s Maybe Bounds
b
pv :: Parser ByteString Info
pv = ((Position, [Ply]) -> Info)
-> Parser ByteString (Position, [Ply]) -> Parser ByteString Info
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([Ply] -> Info
PV ([Ply] -> Info)
-> ((Position, [Ply]) -> [Ply]) -> (Position, [Ply]) -> Info
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Ply] -> [Ply]
forall a. [a] -> [a]
reverse ([Ply] -> [Ply])
-> ((Position, [Ply]) -> [Ply]) -> (Position, [Ply]) -> [Ply]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Position, [Ply]) -> [Ply]
forall a b. (a, b) -> b
snd) (Parser ByteString (Position, [Ply]) -> Parser ByteString Info)
-> Parser ByteString (Position, [Ply]) -> Parser ByteString Info
forall a b. (a -> b) -> a -> b
$ ((Position, [Ply])
-> String -> Parser ByteString (Position, [Ply]))
-> (Position, [Ply])
-> [String]
-> Parser ByteString (Position, [Ply])
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (Position, [Ply]) -> String -> Parser ByteString (Position, [Ply])
forall (f :: * -> *).
MonadFail f =>
(Position, [Ply]) -> String -> f (Position, [Ply])
toPly (Position
pos, []) ([String] -> Parser ByteString (Position, [Ply]))
-> Parser ByteString [String]
-> Parser ByteString (Position, [Ply])
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Parser ByteString String -> Parser () -> Parser ByteString [String]
forall (f :: * -> *) a s. Alternative f => f a -> f s -> f [a]
sepBy Parser ByteString String
mv Parser ()
skipSpace
toPly :: (Position, [Ply]) -> String -> f (Position, [Ply])
toPly (Position
pos, [Ply]
xs) String
s = case Position -> String -> Maybe Ply
fromUCI Position
pos String
s of
Just Ply
m -> (Position, [Ply]) -> f (Position, [Ply])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Position -> Ply -> Position
unsafeDoPly Position
pos Ply
m, Ply
m Ply -> [Ply] -> [Ply]
forall a. a -> [a] -> [a]
: [Ply]
xs)
Maybe Ply
Nothing -> String -> f (Position, [Ply])
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> f (Position, [Ply])) -> String -> f (Position, [Ply])
forall a b. (a -> b) -> a -> b
$ String
"Failed to parse move " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
s
currmove :: Parser ByteString Info
currmove = (String -> Maybe Ply)
-> Parser ByteString String -> Parser ByteString (Maybe Ply)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Position -> String -> Maybe Ply
fromUCI Position
pos) Parser ByteString String
mv Parser ByteString (Maybe Ply)
-> (Maybe Ply -> Parser ByteString Info) -> Parser ByteString Info
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Just Ply
m -> Info -> Parser ByteString Info
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Info -> Parser ByteString Info) -> Info -> Parser ByteString Info
forall a b. (a -> b) -> a -> b
$ Ply -> Info
CurrMove Ply
m
Maybe Ply
Nothing -> String -> Parser ByteString Info
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Failed to parse move"
mv :: Parser ByteString String
mv = ByteString -> String
BS.unpack (ByteString -> String)
-> ((ByteString, Maybe Char) -> ByteString)
-> (ByteString, Maybe Char)
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString, Maybe Char) -> ByteString
forall a b. (a, b) -> a
fst ((ByteString, Maybe Char) -> String)
-> Parser ByteString (ByteString, Maybe Char)
-> Parser ByteString String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (Maybe Char) -> Parser ByteString (ByteString, Maybe Char)
forall a. Parser a -> Parser (ByteString, a)
match (Parser ByteString Char
sq Parser ByteString Char
-> Parser ByteString Char -> Parser ByteString Char
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString Char
sq Parser ByteString Char
-> Parser (Maybe Char) -> Parser (Maybe Char)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString Char -> Parser (Maybe Char)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional ((Char -> Bool) -> Parser ByteString Char
satisfy Char -> Bool
p)) where
sq :: Parser ByteString Char
sq = (Char -> Bool) -> Parser ByteString Char
satisfy ((Char, Char) -> Char -> Bool
forall a. Ix a => (a, a) -> a -> Bool
inRange (Char
'a', Char
'h')) Parser ByteString Char
-> Parser ByteString Char -> Parser ByteString Char
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Char -> Bool) -> Parser ByteString Char
satisfy ((Char, Char) -> Char -> Bool
forall a. Ix a => (a, a) -> a -> Bool
inRange (Char
'1', Char
'8'))
p :: Char -> Bool
p Char
'q' = Bool
True
p Char
'r' = Bool
True
p Char
'b' = Bool
True
p Char
'n' = Bool
True
p Char
_ = Bool
False
bestmove :: Parser Command
bestmove = do
String
m <- Parser ByteString String
mv
Maybe String
ponder <- Parser ByteString String -> Parser ByteString (Maybe String)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser ()
skipSpace Parser () -> Parser ByteString String -> Parser ByteString String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString ByteString
-> Parser ByteString String -> Parser ByteString String
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
kv Parser ByteString ByteString
"ponder" Parser ByteString String
mv)
case Position -> String -> Maybe Ply
fromUCI Position
pos String
m of
Just Ply
m' -> case Maybe String
ponder of
Maybe String
Nothing -> Command -> Parser Command
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Command -> Parser Command)
-> ((Ply, Maybe Ply) -> Command)
-> (Ply, Maybe Ply)
-> Parser Command
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BestMove -> Command
BestMove (BestMove -> Command)
-> ((Ply, Maybe Ply) -> BestMove) -> (Ply, Maybe Ply) -> Command
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Ply, Maybe Ply) -> BestMove
forall a. a -> Maybe a
Just ((Ply, Maybe Ply) -> Parser Command)
-> (Ply, Maybe Ply) -> Parser Command
forall a b. (a -> b) -> a -> b
$ (Ply
m', Maybe Ply
forall a. Maybe a
Nothing)
Just String
p -> case Position -> String -> Maybe Ply
fromUCI (Position -> Ply -> Position
doPly Position
pos Ply
m') String
p of
Just Ply
p' -> Command -> Parser Command
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Command -> Parser Command)
-> ((Ply, Maybe Ply) -> Command)
-> (Ply, Maybe Ply)
-> Parser Command
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BestMove -> Command
BestMove (BestMove -> Command)
-> ((Ply, Maybe Ply) -> BestMove) -> (Ply, Maybe Ply) -> Command
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Ply, Maybe Ply) -> BestMove
forall a. a -> Maybe a
Just ((Ply, Maybe Ply) -> Parser Command)
-> (Ply, Maybe Ply) -> Parser Command
forall a b. (a -> b) -> a -> b
$ (Ply
m', Ply -> Maybe Ply
forall a. a -> Maybe a
Just Ply
p')
Maybe Ply
Nothing -> String -> Parser Command
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser Command) -> String -> Parser Command
forall a b. (a -> b) -> a -> b
$ String
"Failed to parse ponder move " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
p
Maybe Ply
Nothing -> String -> Parser Command
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser Command) -> String -> Parser Command
forall a b. (a -> b) -> a -> b
$ String
"Failed to parse best move " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
m
kv :: Parser ByteString a -> Parser ByteString b -> Parser ByteString b
kv Parser ByteString a
k Parser ByteString b
v = Parser ByteString a
k Parser ByteString a -> Parser () -> Parser ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
skipSpace Parser () -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString b
v
start :: String -> [String] -> IO (Maybe Engine)
start :: String -> [String] -> IO (Maybe Engine)
start = Time (1 :% 1)
-> (String -> IO ()) -> String -> [String] -> IO (Maybe Engine)
forall (unit :: Rat).
KnownDivRat unit Microsecond =>
Time unit
-> (String -> IO ()) -> String -> [String] -> IO (Maybe Engine)
start' (RatioNat -> Time Second
sec RatioNat
2) String -> IO ()
putStrLn
start' :: KnownDivRat unit Microsecond => Time unit -> (String -> IO ()) -> String -> [String] -> IO (Maybe Engine)
start' :: Time unit
-> (String -> IO ()) -> String -> [String] -> IO (Maybe Engine)
start' Time unit
tout String -> IO ()
outputStrLn String
cmd [String]
args = do
(Just Handle
inH, Just Handle
outH, Maybe Handle
Nothing, ProcessHandle
procH) <- CreateProcess
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
createProcess (String -> [String] -> CreateProcess
proc String
cmd [String]
args) {
std_in :: StdStream
std_in = StdStream
CreatePipe, std_out :: StdStream
std_out = StdStream
CreatePipe
}
Handle -> BufferMode -> IO ()
hSetBuffering Handle
inH BufferMode
LineBuffering
Engine
e <- Handle
-> Handle
-> ProcessHandle
-> (String -> IO ())
-> Maybe ThreadId
-> Maybe ByteString
-> Maybe ByteString
-> HashMap ByteString Option
-> MVar ()
-> IORef Bool
-> TChan [Info]
-> TChan BestMove
-> IORef (Position, [Ply])
-> Engine
Engine Handle
inH Handle
outH ProcessHandle
procH String -> IO ()
outputStrLn Maybe ThreadId
forall a. Maybe a
Nothing Maybe ByteString
forall a. Maybe a
Nothing Maybe ByteString
forall a. Maybe a
Nothing HashMap ByteString Option
forall k v. HashMap k v
HashMap.empty (MVar ()
-> IORef Bool
-> TChan [Info]
-> TChan BestMove
-> IORef (Position, [Ply])
-> Engine)
-> IO (MVar ())
-> IO
(IORef Bool
-> TChan [Info]
-> TChan BestMove
-> IORef (Position, [Ply])
-> Engine)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
IO (MVar ())
forall a. IO (MVar a)
newEmptyMVar IO
(IORef Bool
-> TChan [Info]
-> TChan BestMove
-> IORef (Position, [Ply])
-> Engine)
-> IO (IORef Bool)
-> IO
(TChan [Info]
-> TChan BestMove -> IORef (Position, [Ply]) -> Engine)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Bool -> IO (IORef Bool)
forall a. a -> IO (IORef a)
newIORef Bool
False IO
(TChan [Info]
-> TChan BestMove -> IORef (Position, [Ply]) -> Engine)
-> IO (TChan [Info])
-> IO (TChan BestMove -> IORef (Position, [Ply]) -> Engine)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
IO (TChan [Info])
forall a. IO (TChan a)
newBroadcastTChanIO IO (TChan BestMove -> IORef (Position, [Ply]) -> Engine)
-> IO (TChan BestMove) -> IO (IORef (Position, [Ply]) -> Engine)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> IO (TChan BestMove)
forall a. IO (TChan a)
newBroadcastTChanIO IO (IORef (Position, [Ply]) -> Engine)
-> IO (IORef (Position, [Ply])) -> IO Engine
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
(Position, [Ply]) -> IO (IORef (Position, [Ply]))
forall a. a -> IO (IORef a)
newIORef (Position
startpos, [])
Engine -> Builder -> IO ()
send Engine
e Builder
"uci"
Time unit -> IO Engine -> IO (Maybe Engine)
forall (unit :: Rat) (m :: * -> *) a.
(MonadIO m, KnownDivRat unit Microsecond) =>
Time unit -> IO a -> m (Maybe a)
timeout Time unit
tout (Engine -> IO Engine
initialise Engine
e) IO (Maybe Engine)
-> (Maybe Engine -> IO (Maybe Engine)) -> IO (Maybe Engine)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Just Engine
e' -> do
ThreadId
tid <- IO () -> IO ThreadId
forkIO (IO () -> IO ThreadId)
-> (Engine -> IO ()) -> Engine -> IO ThreadId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Engine -> IO ()
infoReader (Engine -> IO ThreadId) -> Engine -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ Engine
e'
Maybe Engine -> IO (Maybe Engine)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Engine -> IO (Maybe Engine))
-> (Engine -> Maybe Engine) -> Engine -> IO (Maybe Engine)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Engine -> Maybe Engine
forall a. a -> Maybe a
Just (Engine -> IO (Maybe Engine)) -> Engine -> IO (Maybe Engine)
forall a b. (a -> b) -> a -> b
$ Engine
e' { infoThread :: Maybe ThreadId
infoThread = ThreadId -> Maybe ThreadId
forall a. a -> Maybe a
Just ThreadId
tid }
Maybe Engine
Nothing -> Engine -> IO (Maybe ExitCode)
forall (m :: * -> *). MonadIO m => Engine -> m (Maybe ExitCode)
quit Engine
e IO (Maybe ExitCode) -> Maybe Engine -> IO (Maybe Engine)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Maybe Engine
forall a. Maybe a
Nothing
initialise :: Engine -> IO Engine
initialise :: Engine -> IO Engine
initialise c :: Engine
c@Engine{Handle
outH :: Handle
outH :: Engine -> Handle
outH, String -> IO ()
outputStrLn :: String -> IO ()
outputStrLn :: Engine -> String -> IO ()
outputStrLn, IORef (Position, [Ply])
game :: IORef (Position, [Ply])
game :: Engine -> IORef (Position, [Ply])
game} = do
ByteString
l <- Handle -> IO ByteString
BS.hGetLine Handle
outH
Position
pos <- (Position, [Ply]) -> Position
forall a b. (a, b) -> a
fst ((Position, [Ply]) -> Position)
-> IO (Position, [Ply]) -> IO Position
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IORef (Position, [Ply]) -> IO (Position, [Ply])
forall a. IORef a -> IO a
readIORef IORef (Position, [Ply])
game
if ByteString -> Bool
BS.null ByteString
l then Engine -> IO Engine
initialise Engine
c else case Parser Command -> ByteString -> Either String Command
forall a. Parser a -> ByteString -> Either String a
parseOnly (Position -> Parser Command
command Position
pos Parser Command -> Parser () -> Parser Command
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
forall t. Chunk t => Parser t ()
endOfInput) ByteString
l of
Left String
_ -> do
String -> IO ()
outputStrLn (String -> IO ()) -> (ByteString -> String) -> ByteString -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String
BS.unpack (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ ByteString
l
Engine -> IO Engine
initialise Engine
c
Right (Name ByteString
n) -> Engine -> IO Engine
initialise (Engine
c { name :: Maybe ByteString
name = ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
n })
Right (Author ByteString
a) -> Engine -> IO Engine
initialise (Engine
c { author :: Maybe ByteString
author = ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
a })
Right (Option ByteString
name Option
opt) -> Engine -> IO Engine
initialise (Engine
c { options :: HashMap ByteString Option
options = ByteString
-> Option -> HashMap ByteString Option -> HashMap ByteString Option
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HashMap.insert ByteString
name Option
opt (HashMap ByteString Option -> HashMap ByteString Option)
-> HashMap ByteString Option -> HashMap ByteString Option
forall a b. (a -> b) -> a -> b
$ Engine -> HashMap ByteString Option
options Engine
c })
Right Command
UCIOk -> Engine -> IO Engine
forall (f :: * -> *) a. Applicative f => a -> f a
pure Engine
c
infoReader :: Engine -> IO ()
infoReader :: Engine -> IO ()
infoReader e :: Engine
e@Engine{Maybe ByteString
Maybe ThreadId
Handle
IORef Bool
IORef (Position, [Ply])
MVar ()
ProcessHandle
TChan [Info]
TChan BestMove
HashMap ByteString Option
String -> IO ()
game :: IORef (Position, [Ply])
bestMoveChan :: TChan BestMove
infoChan :: TChan [Info]
isSearching :: IORef Bool
isReady :: MVar ()
options :: HashMap ByteString Option
author :: Maybe ByteString
name :: Maybe ByteString
infoThread :: Maybe ThreadId
outputStrLn :: String -> IO ()
procH :: ProcessHandle
outH :: Handle
inH :: Handle
game :: Engine -> IORef (Position, [Ply])
bestMoveChan :: Engine -> TChan BestMove
infoChan :: Engine -> TChan [Info]
isSearching :: Engine -> IORef Bool
isReady :: Engine -> MVar ()
infoThread :: Engine -> Maybe ThreadId
outputStrLn :: Engine -> String -> IO ()
procH :: Engine -> ProcessHandle
outH :: Engine -> Handle
inH :: Engine -> Handle
options :: Engine -> HashMap ByteString Option
author :: Engine -> Maybe ByteString
name :: Engine -> Maybe ByteString
..} = IO () -> IO ()
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
ByteString
l <- Handle -> IO ByteString
BS.hGetLine Handle
outH
Position
pos <- Engine -> IO Position
forall (m :: * -> *). MonadIO m => Engine -> m Position
currentPosition Engine
e
case Parser Command -> ByteString -> Either String Command
forall a. Parser a -> ByteString -> Either String a
parseOnly (Position -> Parser Command
command Position
pos Parser Command -> Parser () -> Parser Command
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
forall t. Chunk t => Parser t ()
endOfInput) ByteString
l of
Left String
err -> String -> IO ()
outputStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
err String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
":" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ByteString -> String
forall a. Show a => a -> String
show ByteString
l
Right Command
ReadyOK -> MVar () -> () -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar ()
isReady ()
Right (Info [Info]
i) -> STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ TChan [Info] -> [Info] -> STM ()
forall a. TChan a -> a -> STM ()
writeTChan TChan [Info]
infoChan [Info]
i
Right (BestMove BestMove
bm) -> do
IORef Bool -> Bool -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef Bool
isSearching Bool
False
STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ TChan BestMove -> BestMove -> STM ()
forall a. TChan a -> a -> STM ()
writeTChan TChan BestMove
bestMoveChan BestMove
bm
isready :: Engine -> IO ()
isready :: Engine -> IO ()
isready e :: Engine
e@Engine{MVar ()
isReady :: MVar ()
isReady :: Engine -> MVar ()
isReady} = do
Engine -> Builder -> IO ()
send Engine
e Builder
"isready"
MVar () -> IO ()
forall a. MVar a -> IO a
takeMVar MVar ()
isReady
send :: Engine -> Builder -> IO ()
send :: Engine -> Builder -> IO ()
send Engine{Handle
inH :: Handle
inH :: Engine -> Handle
inH, ProcessHandle
procH :: ProcessHandle
procH :: Engine -> ProcessHandle
procH} Builder
b = do
Handle -> Builder -> IO ()
hPutBuilder Handle
inH (Builder
b Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"\n")
ProcessHandle -> IO (Maybe ExitCode)
getProcessExitCode ProcessHandle
procH IO (Maybe ExitCode) -> (Maybe ExitCode -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Maybe ExitCode
Nothing -> () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
Just ExitCode
ec -> ExitCode -> IO ()
forall e a. Exception e => e -> IO a
throwIO ExitCode
ec
data SearchParam = SearchMoves [Ply]
| Ponder
| TimeLeft Color (Time Millisecond)
| TimeIncrement Color (Time Millisecond)
| MovesToGo Natural
| MoveTime (Time Millisecond)
| MaxNodes Natural
| MaxDepth Natural
| Infinite
deriving (SearchParam -> SearchParam -> Bool
(SearchParam -> SearchParam -> Bool)
-> (SearchParam -> SearchParam -> Bool) -> Eq SearchParam
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SearchParam -> SearchParam -> Bool
$c/= :: SearchParam -> SearchParam -> Bool
== :: SearchParam -> SearchParam -> Bool
$c== :: SearchParam -> SearchParam -> Bool
Eq, Int -> SearchParam -> ShowS
[SearchParam] -> ShowS
SearchParam -> String
(Int -> SearchParam -> ShowS)
-> (SearchParam -> String)
-> ([SearchParam] -> ShowS)
-> Show SearchParam
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SearchParam] -> ShowS
$cshowList :: [SearchParam] -> ShowS
show :: SearchParam -> String
$cshow :: SearchParam -> String
showsPrec :: Int -> SearchParam -> ShowS
$cshowsPrec :: Int -> SearchParam -> ShowS
Show)
searchmoves :: [Ply] -> SearchParam
searchmoves :: [Ply] -> SearchParam
searchmoves = [Ply] -> SearchParam
SearchMoves
ponder :: SearchParam
ponder :: SearchParam
ponder = SearchParam
Ponder
timeleft, timeincrement :: KnownDivRat unit Millisecond
=> Color -> Time unit -> SearchParam
timeleft :: Color -> Time unit -> SearchParam
timeleft Color
c = Color -> Time Millisecond -> SearchParam
TimeLeft Color
c (Time (1 :% 1000) -> SearchParam)
-> (Time unit -> Time (1 :% 1000)) -> Time unit -> SearchParam
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Time unit -> Time (1 :% 1000)
forall (unitTo :: Rat) (unitFrom :: Rat).
KnownDivRat unitFrom unitTo =>
Time unitFrom -> Time unitTo
toUnit
timeincrement :: Color -> Time unit -> SearchParam
timeincrement Color
c = Color -> Time Millisecond -> SearchParam
TimeIncrement Color
c (Time (1 :% 1000) -> SearchParam)
-> (Time unit -> Time (1 :% 1000)) -> Time unit -> SearchParam
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Time unit -> Time (1 :% 1000)
forall (unitTo :: Rat) (unitFrom :: Rat).
KnownDivRat unitFrom unitTo =>
Time unitFrom -> Time unitTo
toUnit
movestogo :: Natural -> SearchParam
movestogo :: Natural -> SearchParam
movestogo = Natural -> SearchParam
MovesToGo
movetime :: KnownDivRat unit Millisecond => Time unit -> SearchParam
movetime :: Time unit -> SearchParam
movetime = Time (1 :% 1000) -> SearchParam
Time Millisecond -> SearchParam
MoveTime (Time (1 :% 1000) -> SearchParam)
-> (Time unit -> Time (1 :% 1000)) -> Time unit -> SearchParam
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Time unit -> Time (1 :% 1000)
forall (unitTo :: Rat) (unitFrom :: Rat).
KnownDivRat unitFrom unitTo =>
Time unitFrom -> Time unitTo
toUnit
nodes, depth :: Natural -> SearchParam
nodes :: Natural -> SearchParam
nodes = Natural -> SearchParam
MaxNodes
depth :: Natural -> SearchParam
depth = Natural -> SearchParam
MaxDepth
infinite :: SearchParam
infinite :: SearchParam
infinite = SearchParam
Infinite
searching :: MonadIO m => Engine -> m Bool
searching :: Engine -> m Bool
searching Engine{IORef Bool
isSearching :: IORef Bool
isSearching :: Engine -> IORef Bool
isSearching} = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ IORef Bool -> IO Bool
forall a. IORef a -> IO a
readIORef IORef Bool
isSearching
search :: MonadIO m
=> Engine -> [SearchParam]
-> m (TChan BestMove, TChan [Info])
search :: Engine -> [SearchParam] -> m (TChan BestMove, TChan [Info])
search e :: Engine
e@Engine{IORef Bool
isSearching :: IORef Bool
isSearching :: Engine -> IORef Bool
isSearching} [SearchParam]
params = IO (TChan BestMove, TChan [Info])
-> m (TChan BestMove, TChan [Info])
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (TChan BestMove, TChan [Info])
-> m (TChan BestMove, TChan [Info]))
-> IO (TChan BestMove, TChan [Info])
-> m (TChan BestMove, TChan [Info])
forall a b. (a -> b) -> a -> b
$ do
(TChan BestMove, TChan [Info])
chans <- STM (TChan BestMove, TChan [Info])
-> IO (TChan BestMove, TChan [Info])
forall a. STM a -> IO a
atomically (STM (TChan BestMove, TChan [Info])
-> IO (TChan BestMove, TChan [Info]))
-> STM (TChan BestMove, TChan [Info])
-> IO (TChan BestMove, TChan [Info])
forall a b. (a -> b) -> a -> b
$ (,) (TChan BestMove -> TChan [Info] -> (TChan BestMove, TChan [Info]))
-> STM (TChan BestMove)
-> STM (TChan [Info] -> (TChan BestMove, TChan [Info]))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TChan BestMove -> STM (TChan BestMove)
forall a. TChan a -> STM (TChan a)
dupTChan (Engine -> TChan BestMove
bestMoveChan Engine
e)
STM (TChan [Info] -> (TChan BestMove, TChan [Info]))
-> STM (TChan [Info]) -> STM (TChan BestMove, TChan [Info])
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TChan [Info] -> STM (TChan [Info])
forall a. TChan a -> STM (TChan a)
dupTChan (Engine -> TChan [Info]
infoChan Engine
e)
Engine -> Builder -> IO ()
send Engine
e (Builder -> IO ()) -> ([Builder] -> Builder) -> [Builder] -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Builder] -> Builder
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold ([Builder] -> Builder)
-> ([Builder] -> [Builder]) -> [Builder] -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> [Builder] -> [Builder]
forall a. a -> [a] -> [a]
intersperse Builder
" " ([Builder] -> IO ()) -> [Builder] -> IO ()
forall a b. (a -> b) -> a -> b
$ Builder
"go" Builder -> [Builder] -> [Builder]
forall a. a -> [a] -> [a]
: (SearchParam -> [Builder] -> [Builder])
-> [Builder] -> [SearchParam] -> [Builder]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr SearchParam -> [Builder] -> [Builder]
build [Builder]
forall a. Monoid a => a
mempty [SearchParam]
params
IORef Bool -> Bool -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef Bool
isSearching Bool
True
(TChan BestMove, TChan [Info]) -> IO (TChan BestMove, TChan [Info])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TChan BestMove, TChan [Info])
chans
where
build :: SearchParam -> [Builder] -> [Builder]
build (SearchMoves [Ply]
plies) [Builder]
xs = Builder
"searchmoves" Builder -> [Builder] -> [Builder]
forall a. a -> [a] -> [a]
: (String -> Builder
forall a. IsString a => String -> a
fromString (String -> Builder) -> (Ply -> String) -> Ply -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ply -> String
toUCI (Ply -> Builder) -> [Ply] -> [Builder]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Ply]
plies) [Builder] -> [Builder] -> [Builder]
forall a. Semigroup a => a -> a -> a
<> [Builder]
xs
build SearchParam
Ponder [Builder]
xs = Builder
"ponder" Builder -> [Builder] -> [Builder]
forall a. a -> [a] -> [a]
: [Builder]
xs
build (TimeLeft Color
White (RatioNat -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
floor (RatioNat -> Integer)
-> (Time (1 :% 1000) -> RatioNat) -> Time (1 :% 1000) -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Time (1 :% 1000) -> RatioNat
forall (rat :: Rat). Time rat -> RatioNat
unTime -> Integer
x)) [Builder]
xs = Builder
"wtime" Builder -> [Builder] -> [Builder]
forall a. a -> [a] -> [a]
: Integer -> Builder
integerDec Integer
x Builder -> [Builder] -> [Builder]
forall a. a -> [a] -> [a]
: [Builder]
xs
build (TimeLeft Color
Black (RatioNat -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
floor (RatioNat -> Integer)
-> (Time (1 :% 1000) -> RatioNat) -> Time (1 :% 1000) -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Time (1 :% 1000) -> RatioNat
forall (rat :: Rat). Time rat -> RatioNat
unTime -> Integer
x)) [Builder]
xs = Builder
"btime" Builder -> [Builder] -> [Builder]
forall a. a -> [a] -> [a]
: Integer -> Builder
integerDec Integer
x Builder -> [Builder] -> [Builder]
forall a. a -> [a] -> [a]
: [Builder]
xs
build (TimeIncrement Color
White (RatioNat -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
floor (RatioNat -> Integer)
-> (Time (1 :% 1000) -> RatioNat) -> Time (1 :% 1000) -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Time (1 :% 1000) -> RatioNat
forall (rat :: Rat). Time rat -> RatioNat
unTime -> Integer
x)) [Builder]
xs = Builder
"winc" Builder -> [Builder] -> [Builder]
forall a. a -> [a] -> [a]
: Integer -> Builder
integerDec Integer
x Builder -> [Builder] -> [Builder]
forall a. a -> [a] -> [a]
: [Builder]
xs
build (TimeIncrement Color
Black (RatioNat -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
floor (RatioNat -> Integer)
-> (Time (1 :% 1000) -> RatioNat) -> Time (1 :% 1000) -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Time (1 :% 1000) -> RatioNat
forall (rat :: Rat). Time rat -> RatioNat
unTime -> Integer
x)) [Builder]
xs = Builder
"binc" Builder -> [Builder] -> [Builder]
forall a. a -> [a] -> [a]
: Integer -> Builder
integerDec Integer
x Builder -> [Builder] -> [Builder]
forall a. a -> [a] -> [a]
: [Builder]
xs
build (MovesToGo Natural
x) [Builder]
xs = Builder
"movestogo" Builder -> [Builder] -> [Builder]
forall a. a -> [a] -> [a]
: Natural -> Builder
naturalDec Natural
x Builder -> [Builder] -> [Builder]
forall a. a -> [a] -> [a]
: [Builder]
xs
build (MoveTime (RatioNat -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
floor (RatioNat -> Integer)
-> (Time (1 :% 1000) -> RatioNat) -> Time (1 :% 1000) -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Time (1 :% 1000) -> RatioNat
forall (rat :: Rat). Time rat -> RatioNat
unTime -> Integer
x)) [Builder]
xs = Builder
"movetime" Builder -> [Builder] -> [Builder]
forall a. a -> [a] -> [a]
: Integer -> Builder
integerDec Integer
x Builder -> [Builder] -> [Builder]
forall a. a -> [a] -> [a]
: [Builder]
xs
build (MaxNodes Natural
x) [Builder]
xs = Builder
"nodes" Builder -> [Builder] -> [Builder]
forall a. a -> [a] -> [a]
: Natural -> Builder
naturalDec Natural
x Builder -> [Builder] -> [Builder]
forall a. a -> [a] -> [a]
: [Builder]
xs
build (MaxDepth Natural
x) [Builder]
xs = Builder
"depth" Builder -> [Builder] -> [Builder]
forall a. a -> [a] -> [a]
: Natural -> Builder
naturalDec Natural
x Builder -> [Builder] -> [Builder]
forall a. a -> [a] -> [a]
: [Builder]
xs
build SearchParam
Infinite [Builder]
xs = Builder
"infinite" Builder -> [Builder] -> [Builder]
forall a. a -> [a] -> [a]
: [Builder]
xs
naturalDec :: Natural -> Builder
naturalDec = Integer -> Builder
integerDec (Integer -> Builder) -> (Natural -> Integer) -> Natural -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Natural -> Integer
forall a. Integral a => a -> Integer
toInteger
ponderhit :: MonadIO m => Engine -> m ()
ponderhit :: Engine -> m ()
ponderhit Engine
e = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Engine -> Builder -> IO ()
send Engine
e Builder
"ponderhit"
stop :: MonadIO m => Engine -> m ()
stop :: Engine -> m ()
stop Engine
e = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Engine -> Builder -> IO ()
send Engine
e Builder
"stop"
getOption :: ByteString -> Engine -> Maybe Option
getOption :: ByteString -> Engine -> Maybe Option
getOption ByteString
n = ByteString -> HashMap ByteString Option -> Maybe Option
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup ByteString
n (HashMap ByteString Option -> Maybe Option)
-> (Engine -> HashMap ByteString Option) -> Engine -> Maybe Option
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Engine -> HashMap ByteString Option
options
setOptionSpinButton :: MonadIO m => ByteString -> Int -> Engine -> m Engine
setOptionSpinButton :: ByteString -> Int -> Engine -> m Engine
setOptionSpinButton ByteString
n Int
v Engine
c
| Just (SpinButton Int
_ Int
minValue Int
maxValue) <- ByteString -> Engine -> Maybe Option
getOption ByteString
n Engine
c
, (Int, Int) -> Int -> Bool
forall a. Ix a => (a, a) -> a -> Bool
inRange (Int
minValue, Int
maxValue) Int
v
= IO Engine -> m Engine
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Engine -> m Engine) -> IO Engine -> m Engine
forall a b. (a -> b) -> a -> b
$ do
Engine -> Builder -> IO ()
send Engine
c (Builder -> IO ()) -> Builder -> IO ()
forall a b. (a -> b) -> a -> b
$ Builder
"setoption name " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
byteString ByteString
n Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" value " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder
intDec Int
v
Engine -> IO Engine
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Engine -> IO Engine) -> Engine -> IO Engine
forall a b. (a -> b) -> a -> b
$ Engine
c { options :: HashMap ByteString Option
options = (Option -> Maybe Option)
-> ByteString
-> HashMap ByteString Option
-> HashMap ByteString Option
forall k a.
(Eq k, Hashable k) =>
(a -> Maybe a) -> k -> HashMap k a -> HashMap k a
HashMap.update (Int -> Option -> Maybe Option
set Int
v) ByteString
n (HashMap ByteString Option -> HashMap ByteString Option)
-> HashMap ByteString Option -> HashMap ByteString Option
forall a b. (a -> b) -> a -> b
$ Engine -> HashMap ByteString Option
options Engine
c }
where
set :: Int -> Option -> Maybe Option
set Int
val opt :: Option
opt@SpinButton{} = Option -> Maybe Option
forall a. a -> Maybe a
Just (Option -> Maybe Option) -> Option -> Maybe Option
forall a b. (a -> b) -> a -> b
$ Option
opt { spinButtonValue :: Int
spinButtonValue = Int
val }
setOptionString :: MonadIO m => ByteString -> ByteString -> Engine -> m Engine
setOptionString :: ByteString -> ByteString -> Engine -> m Engine
setOptionString ByteString
n ByteString
v Engine
e = IO Engine -> m Engine
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Engine -> m Engine) -> IO Engine -> m Engine
forall a b. (a -> b) -> a -> b
$ do
Engine -> Builder -> IO ()
send Engine
e (Builder -> IO ()) -> Builder -> IO ()
forall a b. (a -> b) -> a -> b
$ Builder
"setoption name " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
byteString ByteString
n Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" value " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
byteString ByteString
v
Engine -> IO Engine
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Engine -> IO Engine) -> Engine -> IO Engine
forall a b. (a -> b) -> a -> b
$ Engine
e { options :: HashMap ByteString Option
options = (Option -> Maybe Option)
-> ByteString
-> HashMap ByteString Option
-> HashMap ByteString Option
forall k a.
(Eq k, Hashable k) =>
(a -> Maybe a) -> k -> HashMap k a -> HashMap k a
HashMap.update (ByteString -> Option -> Maybe Option
forall p. ByteString -> p -> Maybe Option
set ByteString
v) ByteString
n (HashMap ByteString Option -> HashMap ByteString Option)
-> HashMap ByteString Option -> HashMap ByteString Option
forall a b. (a -> b) -> a -> b
$ Engine -> HashMap ByteString Option
options Engine
e }
where
set :: ByteString -> p -> Maybe Option
set ByteString
val p
_ = Option -> Maybe Option
forall a. a -> Maybe a
Just (Option -> Maybe Option) -> Option -> Maybe Option
forall a b. (a -> b) -> a -> b
$ ByteString -> Option
OString ByteString
val
currentPosition :: MonadIO m => Engine -> m Position
currentPosition :: Engine -> m Position
currentPosition Engine{IORef (Position, [Ply])
game :: IORef (Position, [Ply])
game :: Engine -> IORef (Position, [Ply])
game} = IO Position -> m Position
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Position -> m Position) -> IO Position -> m Position
forall a b. (a -> b) -> a -> b
$
(Position -> [Ply] -> Position) -> (Position, [Ply]) -> Position
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ((Position -> Ply -> Position) -> Position -> [Ply] -> Position
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Position -> Ply -> Position
doPly) ((Position, [Ply]) -> Position)
-> IO (Position, [Ply]) -> IO Position
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IORef (Position, [Ply]) -> IO (Position, [Ply])
forall a. IORef a -> IO a
readIORef IORef (Position, [Ply])
game
addPly :: MonadIO m => Engine -> Ply -> m ()
addPly :: Engine -> Ply -> m ()
addPly e :: Engine
e@Engine{IORef (Position, [Ply])
game :: IORef (Position, [Ply])
game :: Engine -> IORef (Position, [Ply])
game} Ply
m = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
Position
pos <- Engine -> IO Position
forall (m :: * -> *). MonadIO m => Engine -> m Position
currentPosition Engine
e
if Ply
m Ply -> [Ply] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` Position -> [Ply]
legalPlies Position
pos then UCIException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (UCIException -> IO ()) -> UCIException -> IO ()
forall a b. (a -> b) -> a -> b
$ Ply -> UCIException
IllegalMove Ply
m else do
IORef (Position, [Ply])
-> ((Position, [Ply]) -> ((Position, [Ply]), ())) -> IO ()
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' IORef (Position, [Ply])
game (((Position, [Ply]) -> ((Position, [Ply]), ())) -> IO ())
-> ((Position, [Ply]) -> ((Position, [Ply]), ())) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(Position, [Ply])
g -> (([Ply] -> [Ply]) -> (Position, [Ply]) -> (Position, [Ply])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([Ply] -> [Ply] -> [Ply]
forall a. Semigroup a => a -> a -> a
<> [Ply
m]) (Position, [Ply])
g, ())
Engine -> IO ()
sendPosition Engine
e
replacePly :: MonadIO m => Engine -> Ply -> m ()
replacePly :: Engine -> Ply -> m ()
replacePly e :: Engine
e@Engine{IORef (Position, [Ply])
game :: IORef (Position, [Ply])
game :: Engine -> IORef (Position, [Ply])
game} Ply
pl = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
IORef (Position, [Ply])
-> ((Position, [Ply]) -> ((Position, [Ply]), ())) -> IO ()
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' IORef (Position, [Ply])
game (((Position, [Ply]) -> ((Position, [Ply]), ())) -> IO ())
-> ((Position, [Ply]) -> ((Position, [Ply]), ())) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(Position, [Ply])
g ->
(([Ply] -> [Ply]) -> (Position, [Ply]) -> (Position, [Ply])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Ply] -> [Ply]
forall a. [a] -> [a]
init (Position, [Ply])
g, ())
Engine -> Ply -> IO ()
forall (m :: * -> *). MonadIO m => Engine -> Ply -> m ()
addPly Engine
e Ply
pl
sendPosition :: Engine -> IO ()
sendPosition :: Engine -> IO ()
sendPosition e :: Engine
e@Engine{IORef (Position, [Ply])
game :: IORef (Position, [Ply])
game :: Engine -> IORef (Position, [Ply])
game} = IORef (Position, [Ply]) -> IO (Position, [Ply])
forall a. IORef a -> IO a
readIORef IORef (Position, [Ply])
game IO (Position, [Ply]) -> ((Position, [Ply]) -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Engine -> Builder -> IO ()
send Engine
e (Builder -> IO ())
-> ((Position, [Ply]) -> Builder) -> (Position, [Ply]) -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Position, [Ply]) -> Builder
forall c. (Monoid c, IsString c) => (Position, [Ply]) -> c
cmd where
cmd :: (Position, [Ply]) -> c
cmd (Position
p, [Ply]
h) = [c] -> c
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold ([c] -> c) -> ([c] -> [c]) -> [c] -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. c -> [c] -> [c]
forall a. a -> [a] -> [a]
intersperse c
" " ([c] -> c) -> [c] -> c
forall a b. (a -> b) -> a -> b
$
c
"position" c -> [c] -> [c]
forall a. a -> [a] -> [a]
: c
"fen" c -> [c] -> [c]
forall a. a -> [a] -> [a]
: String -> c
forall a. IsString a => String -> a
fromString (Position -> String
toFEN Position
p) c -> [c] -> [c]
forall a. a -> [a] -> [a]
: [Ply] -> [c]
forall a. IsString a => [Ply] -> [a]
line [Ply]
h
line :: [Ply] -> [a]
line [] = []
line [Ply]
h = a
"moves" a -> [a] -> [a]
forall a. a -> [a] -> [a]
: (String -> a
forall a. IsString a => String -> a
fromString (String -> a) -> (Ply -> String) -> Ply -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ply -> String
toUCI (Ply -> a) -> [Ply] -> [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Ply]
h)
quit :: MonadIO m => Engine -> m (Maybe ExitCode)
quit :: Engine -> m (Maybe ExitCode)
quit = Time (1 :% 1) -> Engine -> m (Maybe ExitCode)
forall (unit :: Rat) (m :: * -> *).
(KnownDivRat unit Microsecond, MonadIO m) =>
Time unit -> Engine -> m (Maybe ExitCode)
quit' (RatioNat -> Time Second
sec RatioNat
1)
quit' :: (KnownDivRat unit Microsecond, MonadIO m)
=> Time unit -> Engine -> m (Maybe ExitCode)
quit' :: Time unit -> Engine -> m (Maybe ExitCode)
quit' Time unit
t e :: Engine
e@Engine{ProcessHandle
procH :: ProcessHandle
procH :: Engine -> ProcessHandle
procH, Maybe ThreadId
infoThread :: Maybe ThreadId
infoThread :: Engine -> Maybe ThreadId
infoThread} = IO (Maybe ExitCode) -> m (Maybe ExitCode)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe ExitCode) -> m (Maybe ExitCode))
-> IO (Maybe ExitCode) -> m (Maybe ExitCode)
forall a b. (a -> b) -> a -> b
$ (Maybe ExitCode -> IO (Maybe ExitCode)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe ExitCode -> IO (Maybe ExitCode))
-> (ExitCode -> Maybe ExitCode) -> ExitCode -> IO (Maybe ExitCode)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExitCode -> Maybe ExitCode
forall a. a -> Maybe a
Just) (ExitCode -> IO (Maybe ExitCode))
-> IO (Maybe ExitCode) -> IO (Maybe ExitCode)
forall e a. Exception e => (e -> IO a) -> IO a -> IO a
`handle` do
IO () -> (ThreadId -> IO ()) -> Maybe ThreadId -> IO ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) ThreadId -> IO ()
killThread Maybe ThreadId
infoThread
Engine -> Builder -> IO ()
send Engine
e Builder
"quit"
Time unit -> IO ExitCode -> IO (Maybe ExitCode)
forall (unit :: Rat) (m :: * -> *) a.
(MonadIO m, KnownDivRat unit Microsecond) =>
Time unit -> IO a -> m (Maybe a)
timeout Time unit
t (ProcessHandle -> IO ExitCode
waitForProcess ProcessHandle
procH) IO (Maybe ExitCode)
-> (Maybe ExitCode -> IO (Maybe ExitCode)) -> IO (Maybe ExitCode)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Just ExitCode
ec -> Maybe ExitCode -> IO (Maybe ExitCode)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe ExitCode -> IO (Maybe ExitCode))
-> Maybe ExitCode -> IO (Maybe ExitCode)
forall a b. (a -> b) -> a -> b
$ ExitCode -> Maybe ExitCode
forall a. a -> Maybe a
Just ExitCode
ec
Maybe ExitCode
Nothing -> ProcessHandle -> IO ()
terminateProcess ProcessHandle
procH IO () -> Maybe ExitCode -> IO (Maybe ExitCode)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Maybe ExitCode
forall a. Maybe a
Nothing