module Game.Chess.UCI (
  -- * Exceptions
  UCIException(..)
  -- * The Engine data type
, Engine, BestMove, name, author
  -- * Starting a UCI engine
, start, start'
  -- * Engine options
, Option(..), options, getOption, setOptionSpinButton, setOptionString
  -- * Manipulating the current game information
, isready
, currentPosition, setPosition, addPly, replacePly
  -- * The Info data type
, Info(..), Score(..), Bounds(..)
  -- * Searching
, search, searching
, SearchParam
, searchmoves, ponder, timeleft, timeincrement, movestogo, movetime, nodes, depth, infinite
, ponderhit
, stop
  -- * Quitting
, quit, quit'
) where

import Control.Applicative
import Control.Concurrent
import Control.Concurrent.STM hiding (check)
import Control.Exception
import Control.Monad
import Control.Monad.IO.Class
import Data.Attoparsec.Combinator
import Data.Attoparsec.ByteString.Char8
import Data.ByteString.Builder
import Data.ByteString.Char8 (ByteString)
import qualified Data.ByteString.Char8 as BS
import Data.Foldable
import Data.Functor
import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as HashMap
import Data.IORef
import Data.Ix
import Data.List
import Data.String (IsString(..))
import Game.Chess
import Numeric.Natural
import System.Exit (ExitCode)
import System.IO
import System.Process
import Time.Rational
import Time.Units

type BestMove = Maybe (Ply, Maybe Ply)

data Engine = Engine {
  Engine -> Handle
inH :: Handle
, Engine -> Handle
outH :: Handle
, Engine -> ProcessHandle
procH :: ProcessHandle
, Engine -> String -> IO ()
outputStrLn :: String -> IO ()
, Engine -> Maybe ThreadId
infoThread :: Maybe ThreadId
, Engine -> Maybe ByteString
name :: Maybe ByteString
, Engine -> Maybe ByteString
author :: Maybe ByteString
, Engine -> HashMap ByteString Option
options :: HashMap ByteString Option
, Engine -> MVar ()
isReady :: MVar ()
, Engine -> IORef Bool
isSearching :: IORef Bool
, Engine -> TChan [Info]
infoChan :: TChan [Info]
, Engine -> TChan BestMove
bestMoveChan :: TChan BestMove
, Engine -> IORef (Position, [Ply])
game :: IORef (Position, [Ply])
}

-- | Set the starting position of the current game, also clearing any
-- pre-existing history.
setPosition :: MonadIO m
            => Engine -> Position
            -> m (Position, [Ply])
              -- ^ the game previously in progress
setPosition :: Engine -> Position -> m (Position, [Ply])
setPosition e :: Engine
e@Engine{IORef (Position, [Ply])
game :: IORef (Position, [Ply])
game :: Engine -> IORef (Position, [Ply])
game} Position
p = IO (Position, [Ply]) -> m (Position, [Ply])
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Position, [Ply]) -> m (Position, [Ply]))
-> IO (Position, [Ply]) -> m (Position, [Ply])
forall a b. (a -> b) -> a -> b
$ do
  (Position, [Ply])
oldGame <- IORef (Position, [Ply])
-> ((Position, [Ply]) -> ((Position, [Ply]), (Position, [Ply])))
-> IO (Position, [Ply])
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' IORef (Position, [Ply])
game ((Position
p, []),)
  Engine -> IO ()
sendPosition Engine
e
  (Position, [Ply]) -> IO (Position, [Ply])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Position, [Ply])
oldGame

data UCIException = IllegalMove Ply deriving Int -> UCIException -> ShowS
[UCIException] -> ShowS
UCIException -> String
(Int -> UCIException -> ShowS)
-> (UCIException -> String)
-> ([UCIException] -> ShowS)
-> Show UCIException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UCIException] -> ShowS
$cshowList :: [UCIException] -> ShowS
show :: UCIException -> String
$cshow :: UCIException -> String
showsPrec :: Int -> UCIException -> ShowS
$cshowsPrec :: Int -> UCIException -> ShowS
Show

instance Exception UCIException

data Command = Name !ByteString
             | Author !ByteString
             | Option !ByteString !Option
             | UCIOk
             | ReadyOK
             | Info [Info]
             | BestMove !BestMove
             deriving (Int -> Command -> ShowS
[Command] -> ShowS
Command -> String
(Int -> Command -> ShowS)
-> (Command -> String) -> ([Command] -> ShowS) -> Show Command
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Command] -> ShowS
$cshowList :: [Command] -> ShowS
show :: Command -> String
$cshow :: Command -> String
showsPrec :: Int -> Command -> ShowS
$cshowsPrec :: Int -> Command -> ShowS
Show)

data Info = PV [Ply]
          | Depth Int
          | SelDepth Int
          | Elapsed (Time Millisecond)
          | MultiPV Int
          | Score Score (Maybe Bounds)
          | Nodes Int
          | NPS Int
          | TBHits Int
          | HashFull Int
          | CurrMove Ply
          | CurrMoveNumber Int
          | String ByteString
          deriving (Info -> Info -> Bool
(Info -> Info -> Bool) -> (Info -> Info -> Bool) -> Eq Info
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Info -> Info -> Bool
$c/= :: Info -> Info -> Bool
== :: Info -> Info -> Bool
$c== :: Info -> Info -> Bool
Eq, Int -> Info -> ShowS
[Info] -> ShowS
Info -> String
(Int -> Info -> ShowS)
-> (Info -> String) -> ([Info] -> ShowS) -> Show Info
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Info] -> ShowS
$cshowList :: [Info] -> ShowS
show :: Info -> String
$cshow :: Info -> String
showsPrec :: Int -> Info -> ShowS
$cshowsPrec :: Int -> Info -> ShowS
Show)

data Score = CentiPawns Int
           | MateIn Int
           deriving (Score -> Score -> Bool
(Score -> Score -> Bool) -> (Score -> Score -> Bool) -> Eq Score
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Score -> Score -> Bool
$c/= :: Score -> Score -> Bool
== :: Score -> Score -> Bool
$c== :: Score -> Score -> Bool
Eq, Eq Score
Eq Score
-> (Score -> Score -> Ordering)
-> (Score -> Score -> Bool)
-> (Score -> Score -> Bool)
-> (Score -> Score -> Bool)
-> (Score -> Score -> Bool)
-> (Score -> Score -> Score)
-> (Score -> Score -> Score)
-> Ord Score
Score -> Score -> Bool
Score -> Score -> Ordering
Score -> Score -> Score
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Score -> Score -> Score
$cmin :: Score -> Score -> Score
max :: Score -> Score -> Score
$cmax :: Score -> Score -> Score
>= :: Score -> Score -> Bool
$c>= :: Score -> Score -> Bool
> :: Score -> Score -> Bool
$c> :: Score -> Score -> Bool
<= :: Score -> Score -> Bool
$c<= :: Score -> Score -> Bool
< :: Score -> Score -> Bool
$c< :: Score -> Score -> Bool
compare :: Score -> Score -> Ordering
$ccompare :: Score -> Score -> Ordering
$cp1Ord :: Eq Score
Ord, Int -> Score -> ShowS
[Score] -> ShowS
Score -> String
(Int -> Score -> ShowS)
-> (Score -> String) -> ([Score] -> ShowS) -> Show Score
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Score] -> ShowS
$cshowList :: [Score] -> ShowS
show :: Score -> String
$cshow :: Score -> String
showsPrec :: Int -> Score -> ShowS
$cshowsPrec :: Int -> Score -> ShowS
Show)
           
data Bounds = UpperBound | LowerBound deriving (Bounds -> Bounds -> Bool
(Bounds -> Bounds -> Bool)
-> (Bounds -> Bounds -> Bool) -> Eq Bounds
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Bounds -> Bounds -> Bool
$c/= :: Bounds -> Bounds -> Bool
== :: Bounds -> Bounds -> Bool
$c== :: Bounds -> Bounds -> Bool
Eq, Int -> Bounds -> ShowS
[Bounds] -> ShowS
Bounds -> String
(Int -> Bounds -> ShowS)
-> (Bounds -> String) -> ([Bounds] -> ShowS) -> Show Bounds
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Bounds] -> ShowS
$cshowList :: [Bounds] -> ShowS
show :: Bounds -> String
$cshow :: Bounds -> String
showsPrec :: Int -> Bounds -> ShowS
$cshowsPrec :: Int -> Bounds -> ShowS
Show)


data Option = CheckBox Bool
            | ComboBox { Option -> ByteString
comboBoxValue :: ByteString, Option -> [ByteString]
comboBoxValues :: [ByteString] }
            | SpinButton { Option -> Int
spinButtonValue, Option -> Int
spinButtonMinBound, Option -> Int
spinButtonMaxBound :: Int }
            | OString ByteString
            | Button
            deriving (Option -> Option -> Bool
(Option -> Option -> Bool)
-> (Option -> Option -> Bool) -> Eq Option
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Option -> Option -> Bool
$c/= :: Option -> Option -> Bool
== :: Option -> Option -> Bool
$c== :: Option -> Option -> Bool
Eq, Int -> Option -> ShowS
[Option] -> ShowS
Option -> String
(Int -> Option -> ShowS)
-> (Option -> String) -> ([Option] -> ShowS) -> Show Option
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Option] -> ShowS
$cshowList :: [Option] -> ShowS
show :: Option -> String
$cshow :: Option -> String
showsPrec :: Int -> Option -> ShowS
$cshowsPrec :: Int -> Option -> ShowS
Show)

instance IsString Option where
  fromString :: String -> Option
fromString = ByteString -> Option
OString (ByteString -> Option)
-> (String -> ByteString) -> String -> Option
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
BS.pack

command :: Position -> Parser Command
command :: Position -> Parser Command
command Position
pos = Parser ()
skipSpace Parser () -> Parser Command -> Parser Command
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> [Parser Command] -> Parser Command
forall (f :: * -> *) a. Alternative f => [f a] -> f a
choice
  [ Parser ByteString ByteString
"id" Parser ByteString ByteString -> Parser Command -> Parser Command
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
`kv` Parser Command
name
  , Parser ByteString ByteString
"id" Parser ByteString ByteString -> Parser Command -> Parser Command
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
`kv` Parser Command
author
  , Parser ByteString ByteString
"option" Parser ByteString ByteString -> Parser Command -> Parser Command
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
`kv` Parser Command
opt
  , Parser ByteString ByteString
"uciok" Parser ByteString ByteString -> Command -> Parser Command
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Command
UCIOk
  , Parser ByteString ByteString
"readyok" Parser ByteString ByteString -> Command -> Parser Command
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Command
ReadyOK
  , Parser ByteString ByteString
"info" Parser ByteString ByteString -> Parser Command -> Parser Command
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
`kv` ([Info] -> Command) -> Parser ByteString [Info] -> Parser Command
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Info] -> Command
Info (Parser ByteString Info -> Parser () -> Parser ByteString [Info]
forall (f :: * -> *) a s. Alternative f => f a -> f s -> f [a]
sepBy1 Parser ByteString Info
infoItem Parser ()
skipSpace)
  , Parser ByteString ByteString
"bestmove" Parser ByteString ByteString -> Parser Command -> Parser Command
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
`kv` (Parser ByteString ByteString
"(none)" Parser ByteString ByteString -> Command -> Parser Command
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> BestMove -> Command
BestMove BestMove
forall a. Maybe a
Nothing Parser Command -> Parser Command -> Parser Command
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Command
bestmove)
  ] Parser Command -> Parser () -> Parser Command
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
skipSpace
 where
  name :: Parser Command
name = ByteString -> Command
Name (ByteString -> Command)
-> Parser ByteString ByteString -> Parser Command
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString ByteString
-> Parser ByteString ByteString -> Parser ByteString ByteString
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
kv Parser ByteString ByteString
"name" Parser ByteString ByteString
takeByteString
  author :: Parser Command
author = ByteString -> Command
Author (ByteString -> Command)
-> Parser ByteString ByteString -> Parser Command
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString ByteString
-> Parser ByteString ByteString -> Parser ByteString ByteString
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
kv Parser ByteString ByteString
"author" Parser ByteString ByteString
takeByteString
  opt :: Parser Command
opt = do
    Parser ByteString ByteString -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void Parser ByteString ByteString
"name"
    Parser ()
skipSpace
    ByteString
optName <- String -> ByteString
BS.pack (String -> ByteString)
-> Parser ByteString String -> Parser ByteString ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Char
-> Parser ByteString ByteString -> Parser ByteString String
forall (f :: * -> *) a s. Alternative f => f a -> f s -> f [a]
manyTill Parser ByteString Char
anyChar (Parser ()
skipSpace Parser ()
-> Parser ByteString ByteString -> Parser ByteString ByteString
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString ByteString
"type")
    Parser ()
skipSpace
    Option
optValue <- Parser ByteString Option
spin Parser ByteString Option
-> Parser ByteString Option -> Parser ByteString Option
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ByteString Option
check Parser ByteString Option
-> Parser ByteString Option -> Parser ByteString Option
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ByteString Option
combo Parser ByteString Option
-> Parser ByteString Option -> Parser ByteString Option
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ByteString Option
str Parser ByteString Option
-> Parser ByteString Option -> Parser ByteString Option
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ByteString Option
button
    Command -> Parser Command
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Command -> Parser Command) -> Command -> Parser Command
forall a b. (a -> b) -> a -> b
$ ByteString -> Option -> Command
Option ByteString
optName Option
optValue
  check :: Parser ByteString Option
check =
    (Bool -> Option)
-> Parser ByteString Bool -> Parser ByteString Option
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> Option
CheckBox (Parser ByteString Bool -> Parser ByteString Option)
-> Parser ByteString Bool -> Parser ByteString Option
forall a b. (a -> b) -> a -> b
$ Parser ByteString ByteString
"check" Parser ByteString ByteString -> Parser () -> Parser ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
skipSpace Parser ()
-> Parser ByteString ByteString -> Parser ByteString ByteString
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString ByteString
"default" Parser ByteString ByteString -> Parser () -> Parser ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
skipSpace Parser () -> Parser ByteString Bool -> Parser ByteString Bool
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>
                    (Parser ByteString ByteString
"false" Parser ByteString ByteString -> Bool -> Parser ByteString Bool
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Bool
False Parser ByteString Bool
-> Parser ByteString Bool -> Parser ByteString Bool
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ByteString ByteString
"true" Parser ByteString ByteString -> Bool -> Parser ByteString Bool
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Bool
True)
  spin :: Parser ByteString Option
spin = do
    Parser ByteString ByteString -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void Parser ByteString ByteString
"spin"
    Parser ()
skipSpace
    Int
value <- Parser ByteString ByteString
"default" Parser ByteString ByteString -> Parser () -> Parser ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
skipSpace Parser () -> Parser ByteString Int -> Parser ByteString Int
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString Int -> Parser ByteString Int
forall a. Num a => Parser a -> Parser a
signed Parser ByteString Int
forall a. Integral a => Parser a
decimal Parser ByteString Int -> Parser () -> Parser ByteString Int
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
skipSpace
    Int
minValue <- Parser ByteString ByteString
"min" Parser ByteString ByteString -> Parser () -> Parser ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
skipSpace Parser () -> Parser ByteString Int -> Parser ByteString Int
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString Int -> Parser ByteString Int
forall a. Num a => Parser a -> Parser a
signed Parser ByteString Int
forall a. Integral a => Parser a
decimal Parser ByteString Int -> Parser () -> Parser ByteString Int
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
skipSpace
    Int
maxValue <- Parser ByteString ByteString
"max" Parser ByteString ByteString -> Parser () -> Parser ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
skipSpace Parser () -> Parser ByteString Int -> Parser ByteString Int
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString Int -> Parser ByteString Int
forall a. Num a => Parser a -> Parser a
signed Parser ByteString Int
forall a. Integral a => Parser a
decimal
    Option -> Parser ByteString Option
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Option -> Parser ByteString Option)
-> Option -> Parser ByteString Option
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int -> Option
SpinButton Int
value Int
minValue Int
maxValue
  combo :: Parser ByteString Option
combo = do
    Parser ByteString ByteString -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void Parser ByteString ByteString
"combo"
    Parser ()
skipSpace
    ByteString
def <- (String -> ByteString)
-> Parser ByteString String -> Parser ByteString ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> ByteString
BS.pack (Parser ByteString String -> Parser ByteString ByteString)
-> Parser ByteString String -> Parser ByteString ByteString
forall a b. (a -> b) -> a -> b
$ Parser ByteString ByteString
"default" Parser ByteString ByteString -> Parser () -> Parser ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
skipSpace Parser () -> Parser ByteString String -> Parser ByteString String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString Char -> Parser () -> Parser ByteString String
forall (f :: * -> *) a s. Alternative f => f a -> f s -> f [a]
manyTill Parser ByteString Char
anyChar Parser ()
var
    ([String]
vars, ByteString
lastVar) <- (,) ([String] -> ByteString -> ([String], ByteString))
-> Parser ByteString [String]
-> Parser ByteString (ByteString -> ([String], ByteString))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString String -> Parser ByteString [String]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (Parser ByteString Char -> Parser () -> Parser ByteString String
forall (f :: * -> *) a s. Alternative f => f a -> f s -> f [a]
manyTill Parser ByteString Char
anyChar Parser ()
var)
                           Parser ByteString (ByteString -> ([String], ByteString))
-> Parser ByteString ByteString
-> Parser ByteString ([String], ByteString)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString ByteString
takeByteString
    Option -> Parser ByteString Option
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Option -> Parser ByteString Option)
-> Option -> Parser ByteString Option
forall a b. (a -> b) -> a -> b
$ ByteString -> [ByteString] -> Option
ComboBox ByteString
def ((String -> ByteString) -> [String] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map String -> ByteString
BS.pack [String]
vars [ByteString] -> [ByteString] -> [ByteString]
forall a. Semigroup a => a -> a -> a
<> [ByteString
lastVar])
  var :: Parser ()
var = Parser ()
skipSpace Parser ()
-> Parser ByteString ByteString -> Parser ByteString ByteString
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString ByteString
"var" Parser ByteString ByteString -> Parser () -> Parser ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
skipSpace
  str :: Parser ByteString Option
str = (ByteString -> Option)
-> Parser ByteString ByteString -> Parser ByteString Option
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> Option
OString (Parser ByteString ByteString -> Parser ByteString Option)
-> Parser ByteString ByteString -> Parser ByteString Option
forall a b. (a -> b) -> a -> b
$
    Parser ByteString ByteString
"string" Parser ByteString ByteString -> Parser () -> Parser ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
skipSpace Parser ()
-> Parser ByteString ByteString -> Parser ByteString ByteString
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString ByteString
"default" Parser ByteString ByteString -> Parser () -> Parser ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
skipSpace Parser ()
-> Parser ByteString ByteString -> Parser ByteString ByteString
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString ByteString
takeByteString
  button :: Parser ByteString Option
button = Parser ByteString ByteString
"button" Parser ByteString ByteString -> Option -> Parser ByteString Option
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Option
Button
  infoItem :: Parser ByteString Info
infoItem = Int -> Info
Depth (Int -> Info) -> Parser ByteString Int -> Parser ByteString Info
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString ByteString
-> Parser ByteString Int -> Parser ByteString Int
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
kv Parser ByteString ByteString
"depth" Parser ByteString Int
forall a. Integral a => Parser a
decimal
         Parser ByteString Info
-> Parser ByteString Info -> Parser ByteString Info
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Int -> Info
SelDepth (Int -> Info) -> Parser ByteString Int -> Parser ByteString Info
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString ByteString
-> Parser ByteString Int -> Parser ByteString Int
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
kv Parser ByteString ByteString
"seldepth" Parser ByteString Int
forall a. Integral a => Parser a
decimal
         Parser ByteString Info
-> Parser ByteString Info -> Parser ByteString Info
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Int -> Info
MultiPV (Int -> Info) -> Parser ByteString Int -> Parser ByteString Info
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString ByteString
-> Parser ByteString Int -> Parser ByteString Int
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
kv Parser ByteString ByteString
"multipv" Parser ByteString Int
forall a. Integral a => Parser a
decimal
         Parser ByteString Info
-> Parser ByteString Info -> Parser ByteString Info
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ByteString ByteString
-> Parser ByteString Info -> Parser ByteString Info
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
kv Parser ByteString ByteString
"score" Parser ByteString Info
score
         Parser ByteString Info
-> Parser ByteString Info -> Parser ByteString Info
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Int -> Info
Nodes (Int -> Info) -> Parser ByteString Int -> Parser ByteString Info
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString ByteString
-> Parser ByteString Int -> Parser ByteString Int
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
kv Parser ByteString ByteString
"nodes" Parser ByteString Int
forall a. Integral a => Parser a
decimal
         Parser ByteString Info
-> Parser ByteString Info -> Parser ByteString Info
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Int -> Info
NPS (Int -> Info) -> Parser ByteString Int -> Parser ByteString Info
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString ByteString
-> Parser ByteString Int -> Parser ByteString Int
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
kv Parser ByteString ByteString
"nps" Parser ByteString Int
forall a. Integral a => Parser a
decimal
         Parser ByteString Info
-> Parser ByteString Info -> Parser ByteString Info
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Int -> Info
HashFull (Int -> Info) -> Parser ByteString Int -> Parser ByteString Info
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString ByteString
-> Parser ByteString Int -> Parser ByteString Int
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
kv Parser ByteString ByteString
"hashfull" Parser ByteString Int
forall a. Integral a => Parser a
decimal
         Parser ByteString Info
-> Parser ByteString Info -> Parser ByteString Info
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Int -> Info
TBHits (Int -> Info) -> Parser ByteString Int -> Parser ByteString Info
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString ByteString
-> Parser ByteString Int -> Parser ByteString Int
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
kv Parser ByteString ByteString
"tbhits" Parser ByteString Int
forall a. Integral a => Parser a
decimal
         Parser ByteString Info
-> Parser ByteString Info -> Parser ByteString Info
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Time (1 :% 1000) -> Info
Time Millisecond -> Info
Elapsed (Time (1 :% 1000) -> Info)
-> (Integer -> Time (1 :% 1000)) -> Integer -> Info
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RatioNat -> Time (1 :% 1000)
RatioNat -> Time Millisecond
ms (RatioNat -> Time (1 :% 1000))
-> (Integer -> RatioNat) -> Integer -> Time (1 :% 1000)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> RatioNat
forall a. Num a => Integer -> a
fromInteger (Integer -> Info)
-> Parser ByteString Integer -> Parser ByteString Info
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString ByteString
-> Parser ByteString Integer -> Parser ByteString Integer
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
kv Parser ByteString ByteString
"time" Parser ByteString Integer
forall a. Integral a => Parser a
decimal
         Parser ByteString Info
-> Parser ByteString Info -> Parser ByteString Info
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ByteString ByteString
-> Parser ByteString Info -> Parser ByteString Info
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
kv Parser ByteString ByteString
"pv" Parser ByteString Info
pv
         Parser ByteString Info
-> Parser ByteString Info -> Parser ByteString Info
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ByteString ByteString
-> Parser ByteString Info -> Parser ByteString Info
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
kv Parser ByteString ByteString
"currmove" Parser ByteString Info
currmove
         Parser ByteString Info
-> Parser ByteString Info -> Parser ByteString Info
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Int -> Info
CurrMoveNumber (Int -> Info) -> Parser ByteString Int -> Parser ByteString Info
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString ByteString
-> Parser ByteString Int -> Parser ByteString Int
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
kv Parser ByteString ByteString
"currmovenumber" Parser ByteString Int
forall a. Integral a => Parser a
decimal
         Parser ByteString Info
-> Parser ByteString Info -> Parser ByteString Info
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ByteString -> Info
String (ByteString -> Info)
-> Parser ByteString ByteString -> Parser ByteString Info
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString ByteString
-> Parser ByteString ByteString -> Parser ByteString ByteString
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
kv Parser ByteString ByteString
"string" Parser ByteString ByteString
takeByteString
  score :: Parser ByteString Info
score = do
    Score
s <- Parser ByteString ByteString
-> Parser ByteString Score -> Parser ByteString Score
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
kv Parser ByteString ByteString
"cp" (Int -> Score
CentiPawns (Int -> Score) -> Parser ByteString Int -> Parser ByteString Score
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Int -> Parser ByteString Int
forall a. Num a => Parser a -> Parser a
signed Parser ByteString Int
forall a. Integral a => Parser a
decimal)
     Parser ByteString Score
-> Parser ByteString Score -> Parser ByteString Score
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ByteString ByteString
-> Parser ByteString Score -> Parser ByteString Score
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
kv Parser ByteString ByteString
"mate" (Int -> Score
MateIn (Int -> Score) -> Parser ByteString Int -> Parser ByteString Score
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Int -> Parser ByteString Int
forall a. Num a => Parser a -> Parser a
signed Parser ByteString Int
forall a. Integral a => Parser a
decimal)
    Maybe Bounds
b <- Parser ByteString Bounds -> Parser ByteString (Maybe Bounds)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser ByteString Bounds -> Parser ByteString (Maybe Bounds))
-> Parser ByteString Bounds -> Parser ByteString (Maybe Bounds)
forall a b. (a -> b) -> a -> b
$ Parser ()
skipSpace Parser () -> Parser ByteString Bounds -> Parser ByteString Bounds
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (  Bounds
UpperBound Bounds -> Parser ByteString ByteString -> Parser ByteString Bounds
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser ByteString ByteString
"upperbound"
                                Parser ByteString Bounds
-> Parser ByteString Bounds -> Parser ByteString Bounds
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Bounds
LowerBound Bounds -> Parser ByteString ByteString -> Parser ByteString Bounds
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser ByteString ByteString
"lowerbound"
                                 )
    Info -> Parser ByteString Info
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Info -> Parser ByteString Info) -> Info -> Parser ByteString Info
forall a b. (a -> b) -> a -> b
$ Score -> Maybe Bounds -> Info
Score Score
s Maybe Bounds
b
  pv :: Parser ByteString Info
pv = ((Position, [Ply]) -> Info)
-> Parser ByteString (Position, [Ply]) -> Parser ByteString Info
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([Ply] -> Info
PV ([Ply] -> Info)
-> ((Position, [Ply]) -> [Ply]) -> (Position, [Ply]) -> Info
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Ply] -> [Ply]
forall a. [a] -> [a]
reverse ([Ply] -> [Ply])
-> ((Position, [Ply]) -> [Ply]) -> (Position, [Ply]) -> [Ply]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Position, [Ply]) -> [Ply]
forall a b. (a, b) -> b
snd) (Parser ByteString (Position, [Ply]) -> Parser ByteString Info)
-> Parser ByteString (Position, [Ply]) -> Parser ByteString Info
forall a b. (a -> b) -> a -> b
$ ((Position, [Ply])
 -> String -> Parser ByteString (Position, [Ply]))
-> (Position, [Ply])
-> [String]
-> Parser ByteString (Position, [Ply])
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (Position, [Ply]) -> String -> Parser ByteString (Position, [Ply])
forall (f :: * -> *).
MonadFail f =>
(Position, [Ply]) -> String -> f (Position, [Ply])
toPly (Position
pos, []) ([String] -> Parser ByteString (Position, [Ply]))
-> Parser ByteString [String]
-> Parser ByteString (Position, [Ply])
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Parser ByteString String -> Parser () -> Parser ByteString [String]
forall (f :: * -> *) a s. Alternative f => f a -> f s -> f [a]
sepBy Parser ByteString String
mv Parser ()
skipSpace
  toPly :: (Position, [Ply]) -> String -> f (Position, [Ply])
toPly (Position
pos, [Ply]
xs) String
s = case Position -> String -> Maybe Ply
fromUCI Position
pos String
s of
    Just Ply
m -> (Position, [Ply]) -> f (Position, [Ply])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Position -> Ply -> Position
unsafeDoPly Position
pos Ply
m, Ply
m Ply -> [Ply] -> [Ply]
forall a. a -> [a] -> [a]
: [Ply]
xs)
    Maybe Ply
Nothing -> String -> f (Position, [Ply])
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> f (Position, [Ply])) -> String -> f (Position, [Ply])
forall a b. (a -> b) -> a -> b
$ String
"Failed to parse move " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
s
  currmove :: Parser ByteString Info
currmove = (String -> Maybe Ply)
-> Parser ByteString String -> Parser ByteString (Maybe Ply)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Position -> String -> Maybe Ply
fromUCI Position
pos) Parser ByteString String
mv Parser ByteString (Maybe Ply)
-> (Maybe Ply -> Parser ByteString Info) -> Parser ByteString Info
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Just Ply
m -> Info -> Parser ByteString Info
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Info -> Parser ByteString Info) -> Info -> Parser ByteString Info
forall a b. (a -> b) -> a -> b
$ Ply -> Info
CurrMove Ply
m
    Maybe Ply
Nothing -> String -> Parser ByteString Info
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Failed to parse move"

  mv :: Parser ByteString String
mv = ByteString -> String
BS.unpack (ByteString -> String)
-> ((ByteString, Maybe Char) -> ByteString)
-> (ByteString, Maybe Char)
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString, Maybe Char) -> ByteString
forall a b. (a, b) -> a
fst ((ByteString, Maybe Char) -> String)
-> Parser ByteString (ByteString, Maybe Char)
-> Parser ByteString String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (Maybe Char) -> Parser ByteString (ByteString, Maybe Char)
forall a. Parser a -> Parser (ByteString, a)
match (Parser ByteString Char
sq Parser ByteString Char
-> Parser ByteString Char -> Parser ByteString Char
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString Char
sq Parser ByteString Char
-> Parser (Maybe Char) -> Parser (Maybe Char)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString Char -> Parser (Maybe Char)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional ((Char -> Bool) -> Parser ByteString Char
satisfy Char -> Bool
p)) where
    sq :: Parser ByteString Char
sq = (Char -> Bool) -> Parser ByteString Char
satisfy ((Char, Char) -> Char -> Bool
forall a. Ix a => (a, a) -> a -> Bool
inRange (Char
'a', Char
'h')) Parser ByteString Char
-> Parser ByteString Char -> Parser ByteString Char
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Char -> Bool) -> Parser ByteString Char
satisfy ((Char, Char) -> Char -> Bool
forall a. Ix a => (a, a) -> a -> Bool
inRange (Char
'1', Char
'8'))
    p :: Char -> Bool
p Char
'q' = Bool
True
    p Char
'r' = Bool
True
    p Char
'b' = Bool
True
    p Char
'n' = Bool
True
    p Char
_ = Bool
False 
  bestmove :: Parser Command
bestmove = do
    String
m <- Parser ByteString String
mv
    Maybe String
ponder <- Parser ByteString String -> Parser ByteString (Maybe String)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser ()
skipSpace Parser () -> Parser ByteString String -> Parser ByteString String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString ByteString
-> Parser ByteString String -> Parser ByteString String
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
kv Parser ByteString ByteString
"ponder" Parser ByteString String
mv)
    case Position -> String -> Maybe Ply
fromUCI Position
pos String
m of
      Just Ply
m' -> case Maybe String
ponder of
        Maybe String
Nothing -> Command -> Parser Command
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Command -> Parser Command)
-> ((Ply, Maybe Ply) -> Command)
-> (Ply, Maybe Ply)
-> Parser Command
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BestMove -> Command
BestMove (BestMove -> Command)
-> ((Ply, Maybe Ply) -> BestMove) -> (Ply, Maybe Ply) -> Command
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Ply, Maybe Ply) -> BestMove
forall a. a -> Maybe a
Just ((Ply, Maybe Ply) -> Parser Command)
-> (Ply, Maybe Ply) -> Parser Command
forall a b. (a -> b) -> a -> b
$ (Ply
m', Maybe Ply
forall a. Maybe a
Nothing)
        Just String
p -> case Position -> String -> Maybe Ply
fromUCI (Position -> Ply -> Position
doPly Position
pos Ply
m') String
p of
          Just Ply
p' -> Command -> Parser Command
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Command -> Parser Command)
-> ((Ply, Maybe Ply) -> Command)
-> (Ply, Maybe Ply)
-> Parser Command
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BestMove -> Command
BestMove (BestMove -> Command)
-> ((Ply, Maybe Ply) -> BestMove) -> (Ply, Maybe Ply) -> Command
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Ply, Maybe Ply) -> BestMove
forall a. a -> Maybe a
Just ((Ply, Maybe Ply) -> Parser Command)
-> (Ply, Maybe Ply) -> Parser Command
forall a b. (a -> b) -> a -> b
$ (Ply
m', Ply -> Maybe Ply
forall a. a -> Maybe a
Just Ply
p')
          Maybe Ply
Nothing -> String -> Parser Command
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser Command) -> String -> Parser Command
forall a b. (a -> b) -> a -> b
$ String
"Failed to parse ponder move " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
p
      Maybe Ply
Nothing -> String -> Parser Command
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser Command) -> String -> Parser Command
forall a b. (a -> b) -> a -> b
$ String
"Failed to parse best move " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
m
  kv :: Parser ByteString a -> Parser ByteString b -> Parser ByteString b
kv Parser ByteString a
k Parser ByteString b
v = Parser ByteString a
k Parser ByteString a -> Parser () -> Parser ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
skipSpace Parser () -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString b
v

-- | Start a UCI engine with the given executable name and command line arguments.
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 a UCI engine with the given timeout for initialisation.
--
-- If the engine takes more then the given microseconds to answer to the
-- initialisation request, 'Nothing' is returned and the external process
-- will be terminated.
start' :: KnownDivRat unit Microsecond => Time unit -> (String -> IO ()) -> String -> [String] -> IO (Maybe Engine)
start' :: Time unit
-> (String -> IO ()) -> String -> [String] -> IO (Maybe Engine)
start' Time unit
tout String -> IO ()
outputStrLn String
cmd [String]
args = do
  (Just Handle
inH, Just Handle
outH, Maybe Handle
Nothing, ProcessHandle
procH) <- CreateProcess
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
createProcess (String -> [String] -> CreateProcess
proc String
cmd [String]
args) {
      std_in :: StdStream
std_in = StdStream
CreatePipe, std_out :: StdStream
std_out = StdStream
CreatePipe
    }
  Handle -> BufferMode -> IO ()
hSetBuffering Handle
inH BufferMode
LineBuffering
  Engine
e <- Handle
-> Handle
-> ProcessHandle
-> (String -> IO ())
-> Maybe ThreadId
-> Maybe ByteString
-> Maybe ByteString
-> HashMap ByteString Option
-> MVar ()
-> IORef Bool
-> TChan [Info]
-> TChan BestMove
-> IORef (Position, [Ply])
-> Engine
Engine Handle
inH Handle
outH ProcessHandle
procH String -> IO ()
outputStrLn Maybe ThreadId
forall a. Maybe a
Nothing Maybe ByteString
forall a. Maybe a
Nothing Maybe ByteString
forall a. Maybe a
Nothing HashMap ByteString Option
forall k v. HashMap k v
HashMap.empty (MVar ()
 -> IORef Bool
 -> TChan [Info]
 -> TChan BestMove
 -> IORef (Position, [Ply])
 -> Engine)
-> IO (MVar ())
-> IO
     (IORef Bool
      -> TChan [Info]
      -> TChan BestMove
      -> IORef (Position, [Ply])
      -> Engine)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
       IO (MVar ())
forall a. IO (MVar a)
newEmptyMVar IO
  (IORef Bool
   -> TChan [Info]
   -> TChan BestMove
   -> IORef (Position, [Ply])
   -> Engine)
-> IO (IORef Bool)
-> IO
     (TChan [Info]
      -> TChan BestMove -> IORef (Position, [Ply]) -> Engine)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Bool -> IO (IORef Bool)
forall a. a -> IO (IORef a)
newIORef Bool
False IO
  (TChan [Info]
   -> TChan BestMove -> IORef (Position, [Ply]) -> Engine)
-> IO (TChan [Info])
-> IO (TChan BestMove -> IORef (Position, [Ply]) -> Engine)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
       IO (TChan [Info])
forall a. IO (TChan a)
newBroadcastTChanIO IO (TChan BestMove -> IORef (Position, [Ply]) -> Engine)
-> IO (TChan BestMove) -> IO (IORef (Position, [Ply]) -> Engine)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> IO (TChan BestMove)
forall a. IO (TChan a)
newBroadcastTChanIO IO (IORef (Position, [Ply]) -> Engine)
-> IO (IORef (Position, [Ply])) -> IO Engine
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
       (Position, [Ply]) -> IO (IORef (Position, [Ply]))
forall a. a -> IO (IORef a)
newIORef (Position
startpos, [])
  Engine -> Builder -> IO ()
send Engine
e Builder
"uci"
  Time unit -> IO Engine -> IO (Maybe Engine)
forall (unit :: Rat) (m :: * -> *) a.
(MonadIO m, KnownDivRat unit Microsecond) =>
Time unit -> IO a -> m (Maybe a)
timeout Time unit
tout (Engine -> IO Engine
initialise Engine
e) IO (Maybe Engine)
-> (Maybe Engine -> IO (Maybe Engine)) -> IO (Maybe Engine)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Just Engine
e' -> do
      ThreadId
tid <- IO () -> IO ThreadId
forkIO (IO () -> IO ThreadId)
-> (Engine -> IO ()) -> Engine -> IO ThreadId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Engine -> IO ()
infoReader (Engine -> IO ThreadId) -> Engine -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ Engine
e'
      Maybe Engine -> IO (Maybe Engine)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Engine -> IO (Maybe Engine))
-> (Engine -> Maybe Engine) -> Engine -> IO (Maybe Engine)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Engine -> Maybe Engine
forall a. a -> Maybe a
Just (Engine -> IO (Maybe Engine)) -> Engine -> IO (Maybe Engine)
forall a b. (a -> b) -> a -> b
$ Engine
e' { infoThread :: Maybe ThreadId
infoThread = ThreadId -> Maybe ThreadId
forall a. a -> Maybe a
Just ThreadId
tid }
    Maybe Engine
Nothing -> Engine -> IO (Maybe ExitCode)
forall (m :: * -> *). MonadIO m => Engine -> m (Maybe ExitCode)
quit Engine
e IO (Maybe ExitCode) -> Maybe Engine -> IO (Maybe Engine)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Maybe Engine
forall a. Maybe a
Nothing

initialise :: Engine -> IO Engine
initialise :: Engine -> IO Engine
initialise c :: Engine
c@Engine{Handle
outH :: Handle
outH :: Engine -> Handle
outH, String -> IO ()
outputStrLn :: String -> IO ()
outputStrLn :: Engine -> String -> IO ()
outputStrLn, IORef (Position, [Ply])
game :: IORef (Position, [Ply])
game :: Engine -> IORef (Position, [Ply])
game} = do
  ByteString
l <- Handle -> IO ByteString
BS.hGetLine Handle
outH
  Position
pos <- (Position, [Ply]) -> Position
forall a b. (a, b) -> a
fst ((Position, [Ply]) -> Position)
-> IO (Position, [Ply]) -> IO Position
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IORef (Position, [Ply]) -> IO (Position, [Ply])
forall a. IORef a -> IO a
readIORef IORef (Position, [Ply])
game
  if ByteString -> Bool
BS.null ByteString
l then Engine -> IO Engine
initialise Engine
c else case Parser Command -> ByteString -> Either String Command
forall a. Parser a -> ByteString -> Either String a
parseOnly (Position -> Parser Command
command Position
pos Parser Command -> Parser () -> Parser Command
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
forall t. Chunk t => Parser t ()
endOfInput) ByteString
l of
    Left String
_ -> do
      String -> IO ()
outputStrLn (String -> IO ()) -> (ByteString -> String) -> ByteString -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String
BS.unpack (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ ByteString
l
      Engine -> IO Engine
initialise Engine
c
    Right (Name ByteString
n) -> Engine -> IO Engine
initialise (Engine
c { name :: Maybe ByteString
name = ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
n })
    Right (Author ByteString
a) -> Engine -> IO Engine
initialise (Engine
c { author :: Maybe ByteString
author = ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
a })
    Right (Option ByteString
name Option
opt) -> Engine -> IO Engine
initialise (Engine
c { options :: HashMap ByteString Option
options = ByteString
-> Option -> HashMap ByteString Option -> HashMap ByteString Option
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HashMap.insert ByteString
name Option
opt (HashMap ByteString Option -> HashMap ByteString Option)
-> HashMap ByteString Option -> HashMap ByteString Option
forall a b. (a -> b) -> a -> b
$ Engine -> HashMap ByteString Option
options Engine
c })
    Right Command
UCIOk -> Engine -> IO Engine
forall (f :: * -> *) a. Applicative f => a -> f a
pure Engine
c

infoReader :: Engine -> IO ()
infoReader :: Engine -> IO ()
infoReader e :: Engine
e@Engine{Maybe ByteString
Maybe ThreadId
Handle
IORef Bool
IORef (Position, [Ply])
MVar ()
ProcessHandle
TChan [Info]
TChan BestMove
HashMap ByteString Option
String -> IO ()
game :: IORef (Position, [Ply])
bestMoveChan :: TChan BestMove
infoChan :: TChan [Info]
isSearching :: IORef Bool
isReady :: MVar ()
options :: HashMap ByteString Option
author :: Maybe ByteString
name :: Maybe ByteString
infoThread :: Maybe ThreadId
outputStrLn :: String -> IO ()
procH :: ProcessHandle
outH :: Handle
inH :: Handle
game :: Engine -> IORef (Position, [Ply])
bestMoveChan :: Engine -> TChan BestMove
infoChan :: Engine -> TChan [Info]
isSearching :: Engine -> IORef Bool
isReady :: Engine -> MVar ()
infoThread :: Engine -> Maybe ThreadId
outputStrLn :: Engine -> String -> IO ()
procH :: Engine -> ProcessHandle
outH :: Engine -> Handle
inH :: Engine -> Handle
options :: Engine -> HashMap ByteString Option
author :: Engine -> Maybe ByteString
name :: Engine -> Maybe ByteString
..} = IO () -> IO ()
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
  ByteString
l <- Handle -> IO ByteString
BS.hGetLine Handle
outH
  Position
pos <- Engine -> IO Position
forall (m :: * -> *). MonadIO m => Engine -> m Position
currentPosition Engine
e
  case Parser Command -> ByteString -> Either String Command
forall a. Parser a -> ByteString -> Either String a
parseOnly (Position -> Parser Command
command Position
pos Parser Command -> Parser () -> Parser Command
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
forall t. Chunk t => Parser t ()
endOfInput) ByteString
l of
    Left String
err -> String -> IO ()
outputStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
err String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
":" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ByteString -> String
forall a. Show a => a -> String
show ByteString
l
    Right Command
ReadyOK -> MVar () -> () -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar ()
isReady ()
    Right (Info [Info]
i) -> STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ TChan [Info] -> [Info] -> STM ()
forall a. TChan a -> a -> STM ()
writeTChan TChan [Info]
infoChan [Info]
i
    Right (BestMove BestMove
bm) -> do
      IORef Bool -> Bool -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef Bool
isSearching Bool
False
      STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ TChan BestMove -> BestMove -> STM ()
forall a. TChan a -> a -> STM ()
writeTChan TChan BestMove
bestMoveChan BestMove
bm

-- | Wait until the engine is ready to take more commands.
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]
                -- ^ restrict search to the specified moves only
                 | Ponder
                -- ^ start searching in pondering mode
                 | TimeLeft Color (Time Millisecond)
                -- ^ time (in milliseconds) left on the clock
                 | TimeIncrement Color (Time Millisecond)
                -- ^ time increment per move in milliseconds
                 | MovesToGo Natural
                -- ^ number of moves to the next time control
                 | MoveTime (Time Millisecond)
                 | MaxNodes Natural
                 | MaxDepth Natural
                 | Infinite
                -- ^ search until 'stop' gets called
                 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

-- | Instruct the engine to begin searching.
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

-- | Switch a ponder search to normal search when the pondered move was played.
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 a search in progress.
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

-- | Set a spin option to a particular value.
--
-- Bounds are validated.  Make sure you don't set a value which is out of range.
setOptionSpinButton :: MonadIO m => ByteString -> Int -> Engine -> m Engine
setOptionSpinButton :: ByteString -> Int -> Engine -> m Engine
setOptionSpinButton ByteString
n Int
v Engine
c
  | Just (SpinButton Int
_ Int
minValue Int
maxValue) <- ByteString -> Engine -> Maybe Option
getOption ByteString
n Engine
c
  , (Int, Int) -> Int -> Bool
forall a. Ix a => (a, a) -> a -> Bool
inRange (Int
minValue, Int
maxValue) Int
v
  = IO Engine -> m Engine
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Engine -> m Engine) -> IO Engine -> m Engine
forall a b. (a -> b) -> a -> b
$ do
    Engine -> Builder -> IO ()
send Engine
c (Builder -> IO ()) -> Builder -> IO ()
forall a b. (a -> b) -> a -> b
$ Builder
"setoption name " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
byteString ByteString
n Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" value " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder
intDec Int
v
    Engine -> IO Engine
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Engine -> IO Engine) -> Engine -> IO Engine
forall a b. (a -> b) -> a -> b
$ Engine
c { options :: HashMap ByteString Option
options = (Option -> Maybe Option)
-> ByteString
-> HashMap ByteString Option
-> HashMap ByteString Option
forall k a.
(Eq k, Hashable k) =>
(a -> Maybe a) -> k -> HashMap k a -> HashMap k a
HashMap.update (Int -> Option -> Maybe Option
set Int
v) ByteString
n (HashMap ByteString Option -> HashMap ByteString Option)
-> HashMap ByteString Option -> HashMap ByteString Option
forall a b. (a -> b) -> a -> b
$ Engine -> HashMap ByteString Option
options Engine
c }
 where
  set :: Int -> Option -> Maybe Option
set Int
val opt :: Option
opt@SpinButton{} = Option -> Maybe Option
forall a. a -> Maybe a
Just (Option -> Maybe Option) -> Option -> Maybe Option
forall a b. (a -> b) -> a -> b
$ Option
opt { spinButtonValue :: Int
spinButtonValue = Int
val }

setOptionString :: MonadIO m => ByteString -> ByteString -> Engine -> m Engine
setOptionString :: ByteString -> ByteString -> Engine -> m Engine
setOptionString ByteString
n ByteString
v Engine
e = IO Engine -> m Engine
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Engine -> m Engine) -> IO Engine -> m Engine
forall a b. (a -> b) -> a -> b
$ do
  Engine -> Builder -> IO ()
send Engine
e (Builder -> IO ()) -> Builder -> IO ()
forall a b. (a -> b) -> a -> b
$ Builder
"setoption name " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
byteString ByteString
n Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" value " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
byteString ByteString
v
  Engine -> IO Engine
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Engine -> IO Engine) -> Engine -> IO Engine
forall a b. (a -> b) -> a -> b
$ Engine
e { options :: HashMap ByteString Option
options = (Option -> Maybe Option)
-> ByteString
-> HashMap ByteString Option
-> HashMap ByteString Option
forall k a.
(Eq k, Hashable k) =>
(a -> Maybe a) -> k -> HashMap k a -> HashMap k a
HashMap.update (ByteString -> Option -> Maybe Option
forall p. ByteString -> p -> Maybe Option
set ByteString
v) ByteString
n (HashMap ByteString Option -> HashMap ByteString Option)
-> HashMap ByteString Option -> HashMap ByteString Option
forall a b. (a -> b) -> a -> b
$ Engine -> HashMap ByteString Option
options Engine
e }
 where
  set :: ByteString -> p -> Maybe Option
set ByteString
val p
_ = Option -> Maybe Option
forall a. a -> Maybe a
Just (Option -> Maybe Option) -> Option -> Maybe Option
forall a b. (a -> b) -> a -> b
$ ByteString -> Option
OString ByteString
val

-- | Return the final position of the currently active game.
currentPosition :: MonadIO m => Engine -> m Position
currentPosition :: Engine -> m Position
currentPosition Engine{IORef (Position, [Ply])
game :: IORef (Position, [Ply])
game :: Engine -> IORef (Position, [Ply])
game} = IO Position -> m Position
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Position -> m Position) -> IO Position -> m Position
forall a b. (a -> b) -> a -> b
$
  (Position -> [Ply] -> Position) -> (Position, [Ply]) -> Position
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ((Position -> Ply -> Position) -> Position -> [Ply] -> Position
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Position -> Ply -> Position
doPly) ((Position, [Ply]) -> Position)
-> IO (Position, [Ply]) -> IO Position
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IORef (Position, [Ply]) -> IO (Position, [Ply])
forall a. IORef a -> IO a
readIORef IORef (Position, [Ply])
game

-- | Add a 'Move' to the game history.
--
-- This function checks if the move is actually legal, and throws a 'UCIException'
-- if it isn't.
addPly :: MonadIO m => Engine -> Ply -> m ()
addPly :: Engine -> Ply -> m ()
addPly e :: Engine
e@Engine{IORef (Position, [Ply])
game :: IORef (Position, [Ply])
game :: Engine -> IORef (Position, [Ply])
game} Ply
m = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
  Position
pos <- Engine -> IO Position
forall (m :: * -> *). MonadIO m => Engine -> m Position
currentPosition Engine
e
  if Ply
m Ply -> [Ply] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` Position -> [Ply]
legalPlies Position
pos then UCIException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (UCIException -> IO ()) -> UCIException -> IO ()
forall a b. (a -> b) -> a -> b
$ Ply -> UCIException
IllegalMove Ply
m else do
    IORef (Position, [Ply])
-> ((Position, [Ply]) -> ((Position, [Ply]), ())) -> IO ()
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' IORef (Position, [Ply])
game (((Position, [Ply]) -> ((Position, [Ply]), ())) -> IO ())
-> ((Position, [Ply]) -> ((Position, [Ply]), ())) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(Position, [Ply])
g -> (([Ply] -> [Ply]) -> (Position, [Ply]) -> (Position, [Ply])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([Ply] -> [Ply] -> [Ply]
forall a. Semigroup a => a -> a -> a
<> [Ply
m]) (Position, [Ply])
g, ())
    Engine -> IO ()
sendPosition Engine
e
 
replacePly :: MonadIO m => Engine -> Ply -> m ()
replacePly :: Engine -> Ply -> m ()
replacePly e :: Engine
e@Engine{IORef (Position, [Ply])
game :: IORef (Position, [Ply])
game :: Engine -> IORef (Position, [Ply])
game} Ply
pl = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
  IORef (Position, [Ply])
-> ((Position, [Ply]) -> ((Position, [Ply]), ())) -> IO ()
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' IORef (Position, [Ply])
game (((Position, [Ply]) -> ((Position, [Ply]), ())) -> IO ())
-> ((Position, [Ply]) -> ((Position, [Ply]), ())) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(Position, [Ply])
g ->
    (([Ply] -> [Ply]) -> (Position, [Ply]) -> (Position, [Ply])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Ply] -> [Ply]
forall a. [a] -> [a]
init (Position, [Ply])
g, ())
  Engine -> Ply -> IO ()
forall (m :: * -> *). MonadIO m => Engine -> Ply -> m ()
addPly Engine
e Ply
pl
  
sendPosition :: Engine -> IO ()
sendPosition :: Engine -> IO ()
sendPosition e :: Engine
e@Engine{IORef (Position, [Ply])
game :: IORef (Position, [Ply])
game :: Engine -> IORef (Position, [Ply])
game} = IORef (Position, [Ply]) -> IO (Position, [Ply])
forall a. IORef a -> IO a
readIORef IORef (Position, [Ply])
game IO (Position, [Ply]) -> ((Position, [Ply]) -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Engine -> Builder -> IO ()
send Engine
e (Builder -> IO ())
-> ((Position, [Ply]) -> Builder) -> (Position, [Ply]) -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Position, [Ply]) -> Builder
forall c. (Monoid c, IsString c) => (Position, [Ply]) -> c
cmd where
  cmd :: (Position, [Ply]) -> c
cmd (Position
p, [Ply]
h) = [c] -> c
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold ([c] -> c) -> ([c] -> [c]) -> [c] -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. c -> [c] -> [c]
forall a. a -> [a] -> [a]
intersperse c
" " ([c] -> c) -> [c] -> c
forall a b. (a -> b) -> a -> b
$
    c
"position" c -> [c] -> [c]
forall a. a -> [a] -> [a]
: c
"fen" c -> [c] -> [c]
forall a. a -> [a] -> [a]
: String -> c
forall a. IsString a => String -> a
fromString (Position -> String
toFEN Position
p) c -> [c] -> [c]
forall a. a -> [a] -> [a]
: [Ply] -> [c]
forall a. IsString a => [Ply] -> [a]
line [Ply]
h
  line :: [Ply] -> [a]
line [] = []
  line [Ply]
h = a
"moves" a -> [a] -> [a]
forall a. a -> [a] -> [a]
: (String -> a
forall a. IsString a => String -> a
fromString (String -> a) -> (Ply -> String) -> Ply -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ply -> String
toUCI (Ply -> a) -> [Ply] -> [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Ply]
h)

-- | Quit the engine.
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