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