{-# 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 :: 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 = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
IO (Position, Seq Ply) -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO (Position, Seq Ply) -> IO ())
-> IO (Position, Seq Ply) -> IO ()
forall a b. (a -> b) -> a -> b
$ IORef (Position, Seq Ply)
-> ((Position, Seq Ply)
-> ((Position, Seq Ply), (Position, Seq Ply)))
-> IO (Position, Seq Ply)
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' IORef (Position, Seq Ply)
game ((Position
p, [Ply] -> Seq Ply
forall a. [a] -> Seq a
Seq.fromList ([Ply] -> Seq Ply) -> [Ply] -> Seq Ply
forall a b. (a -> b) -> a -> b
$ f Ply -> [Ply]
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
(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 !(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
(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 -> [String] -> Either String (Vector Ply)
varToVec Position
pos ([String] -> Either String (Vector Ply))
-> Parser ByteString [String]
-> Parser ByteString (Either String (Vector Ply))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f 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 Parser ByteString (Either String (Vector Ply))
-> (Either String (Vector Ply) -> Parser ByteString Info)
-> Parser ByteString Info
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Right Vector Ply
v -> Info -> Parser ByteString Info
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Info -> Parser ByteString Info)
-> (Vector Ply -> Info) -> Vector Ply -> Parser ByteString Info
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector Ply -> Info
PV (Vector Ply -> Parser ByteString Info)
-> Vector Ply -> Parser ByteString Info
forall a b. (a -> b) -> a -> b
$ Vector Ply
v
Left String
s -> String -> Parser ByteString Info
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser ByteString Info)
-> String -> Parser ByteString Info
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 (HasCallStack => Position -> Ply -> Position
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
varToVec :: Position -> [String] -> Either String (Unboxed.Vector Ply)
varToVec :: Position -> [String] -> Either String (Vector Ply)
varToVec Position
p [String]
xs = (forall s. ST s (Either String (MVector s Ply)))
-> Either String (Vector Ply)
forall (f :: * -> *) a.
(Traversable f, Unbox a) =>
(forall s. ST s (f (MVector s a))) -> f (Vector a)
Unboxed.createT ((forall s. ST s (Either String (MVector s Ply)))
-> Either String (Vector Ply))
-> (forall s. ST s (Either String (MVector s Ply)))
-> Either String (Vector Ply)
forall a b. (a -> b) -> a -> b
$ do
MVector s Ply
v <- Int -> ST s (MVector (PrimState (ST s)) Ply)
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
Int -> m (MVector (PrimState m) a)
Unboxed.new (Int -> ST s (MVector (PrimState (ST s)) Ply))
-> Int -> ST s (MVector (PrimState (ST s)) Ply)
forall a b. (a -> b) -> a -> b
$ [String] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
xs
STRef s Int
i <- Int -> ST s (STRef s Int)
forall a s. a -> ST s (STRef s a)
newSTRef Int
0
STRef s Position
pos <- Position -> ST s (STRef s Position)
forall a s. a -> ST s (STRef s a)
newSTRef Position
p
([Either String ()] -> Either String (MVector s Ply))
-> ST s [Either String ()] -> ST s (Either String (MVector s Ply))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (([()] -> MVector s Ply)
-> Either String [()] -> Either String (MVector s Ply)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (MVector s Ply -> [()] -> MVector s Ply
forall a b. a -> b -> a
const MVector s Ply
v) (Either String [()] -> Either String (MVector s Ply))
-> ([Either String ()] -> Either String [()])
-> [Either String ()]
-> Either String (MVector s Ply)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Either String ()] -> Either String [()]
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA) (ST s [Either String ()] -> ST s (Either String (MVector s Ply)))
-> ST s [Either String ()] -> ST s (Either String (MVector s Ply))
forall a b. (a -> b) -> a -> b
$ [String]
-> (String -> ST s (Either String ())) -> ST s [Either String ()]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [String]
xs ((String -> ST s (Either String ())) -> ST s [Either String ()])
-> (String -> ST s (Either String ())) -> ST s [Either String ()]
forall a b. (a -> b) -> a -> b
$ \String
x -> do
Position
pos' <- STRef s Position -> ST s Position
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' <- STRef s Int -> ST s Int
forall s a. STRef s a -> ST s a
readSTRef STRef s Int
i
MVector (PrimState (ST s)) Ply -> Int -> Ply -> ST s ()
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> a -> m ()
Unboxed.write MVector s Ply
MVector (PrimState (ST s)) Ply
v Int
i' Ply
pl
STRef s Int -> (Int -> Int) -> ST s ()
forall s a. STRef s a -> (a -> a) -> ST s ()
modifySTRef STRef s Int
i (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
STRef s Position -> Position -> ST s ()
forall s a. STRef s a -> a -> ST s ()
writeSTRef STRef s Position
pos (Position -> Ply -> Position
unsafeDoPly Position
pos' Ply
pl)
Either String () -> ST s (Either String ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String () -> ST s (Either String ()))
-> (() -> Either String ()) -> () -> ST s (Either String ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Either String ()
forall a b. b -> Either a b
Right (() -> ST s (Either String ())) -> () -> ST s (Either String ())
forall a b. (a -> b) -> a -> b
$ ()
Maybe Ply
Nothing -> do
Either String () -> ST s (Either String ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String () -> ST s (Either String ()))
-> (String -> Either String ())
-> String
-> ST s (Either String ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Either String ()
forall a b. a -> Either a b
Left (String -> ST s (Either String ()))
-> String -> ST s (Either String ())
forall a b. (a -> b) -> a -> b
$ String
x
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, Seq 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, Seq Ply)
-> Engine)
-> IO (MVar ())
-> IO
(IORef Bool
-> TChan [Info]
-> TChan BestMove
-> IORef (Position, Seq 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, Seq Ply)
-> Engine)
-> IO (IORef Bool)
-> IO
(TChan [Info]
-> TChan BestMove -> IORef (Position, Seq 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, Seq Ply) -> Engine)
-> IO (TChan [Info])
-> IO (TChan BestMove -> IORef (Position, Seq 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, Seq Ply) -> Engine)
-> IO (TChan BestMove) -> IO (IORef (Position, Seq 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, Seq Ply) -> Engine)
-> IO (IORef (Position, Seq Ply)) -> IO Engine
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
(Position, Seq Ply) -> IO (IORef (Position, Seq Ply))
forall a. a -> IO (IORef a)
newIORef (Position
startpos, Seq Ply
forall a. Seq a
Seq.empty)
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, 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 <- (Position, Seq Ply) -> Position
forall a b. (a, b) -> a
fst ((Position, Seq Ply) -> Position)
-> IO (Position, Seq Ply) -> IO Position
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IORef (Position, Seq Ply) -> IO (Position, Seq Ply)
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 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
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
..} = 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
Right Command
_ -> () -> IO ()
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"
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 }
| Bool
otherwise
= String -> m Engine
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{} = 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, Seq Ply)
game :: IORef (Position, Seq Ply)
game :: Engine -> IORef (Position, Seq 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 -> Seq Ply -> Position)
-> (Position, Seq Ply) -> Position
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ((Position -> Ply -> Position) -> Position -> Seq Ply -> Position
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' HasCallStack => Position -> Ply -> Position
Position -> Ply -> Position
doPly) ((Position, Seq Ply) -> Position)
-> IO (Position, Seq Ply) -> IO Position
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IORef (Position, Seq Ply) -> IO (Position, Seq Ply)
forall a. IORef a -> IO a
readIORef IORef (Position, Seq Ply)
game
addPly :: MonadIO m => Engine -> Ply -> m ()
addPly :: 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 = 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, Seq Ply)
-> ((Position, Seq Ply) -> ((Position, Seq Ply), ())) -> IO ()
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' IORef (Position, Seq Ply)
game (((Position, Seq Ply) -> ((Position, Seq Ply), ())) -> IO ())
-> ((Position, Seq Ply) -> ((Position, Seq Ply), ())) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(Position, Seq Ply)
g -> ((Seq Ply -> Seq Ply) -> (Position, Seq Ply) -> (Position, Seq Ply)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Seq Ply -> Ply -> Seq Ply
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 :: 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 = 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, Seq Ply)
-> ((Position, Seq Ply) -> ((Position, Seq Ply), ())) -> IO ()
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' IORef (Position, Seq Ply)
game (((Position, Seq Ply) -> ((Position, Seq Ply), ())) -> IO ())
-> ((Position, Seq Ply) -> ((Position, Seq Ply), ())) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(Position, Seq Ply)
g ->
((Seq Ply -> Seq Ply) -> (Position, Seq Ply) -> (Position, Seq Ply)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Seq Ply
xs -> case Seq Ply -> ViewR Ply
forall a. Seq a -> ViewR a
Seq.viewr Seq Ply
xs of Seq Ply
xs' :> Ply
_ -> Seq Ply
xs') (Position, Seq 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, Seq Ply)
game :: IORef (Position, Seq Ply)
game :: Engine -> IORef (Position, Seq Ply)
game} = IORef (Position, Seq Ply) -> IO (Position, Seq Ply)
forall a. IORef a -> IO a
readIORef IORef (Position, Seq Ply)
game IO (Position, Seq Ply) -> ((Position, Seq 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, Seq Ply) -> Builder) -> (Position, Seq Ply) -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Position, Seq Ply) -> Builder
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) = [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 (t Ply -> [Ply]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList t 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