{-# LANGUAGE FlexibleContexts  #-}
{-# LANGUAGE LambdaCase        #-}
{-# LANGUAGE NamedFieldPuns    #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards   #-}
{-# LANGUAGE TupleSections     #-}
{-# LANGUAGE ViewPatterns      #-}
{-|
Module      : Game.Chess.UCI
Description : Universal Chess Interface
Copyright   : (c) Mario Lang, 2021
License     : BSD3
Maintainer  : mlang@blind.guru
Stability   : experimental

The Universal Chess Interface (UCI) is a protocol for communicating with
external Chess engines.
-}
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              (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)
}

-- | Set the starting position and plies of the current game.
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 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, 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 ()

-- | 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 }
  | 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

-- | Return the final position of the currently active game.
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

-- | 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, 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 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