module Models.Command where
import AppPrelude
import Models.Piece
import Models.Position
import Models.Score
import Utils.Board
import Data.Word
data Command
= Uci
| UciNewGame
| IsReady
| Search SearchOptions
| SetPosition PositionSpec
| SetOption OptionSpec
| Ponderhit
| Stop
| Quit
| MakeMoves [UnknownMove]
| Perft Depth
| Divide Depth
| Evaluate
| Display
| Flip
data EngineInfo = EngineInfo
{ EngineInfo -> Text
name :: Text
, EngineInfo -> Text
version :: Text
, EngineInfo -> Text
author :: Text
}
data EngineOptions = EngineOptions
{ EngineOptions -> Word16
hashSize :: Word16
, EngineOptions -> Bool
ponder :: Bool
}
data EngineOption = SpinOption
{ EngineOption -> Word16
deflt :: Word16
, EngineOption -> Word16
lo :: Word16
, EngineOption -> Word16
hi :: Word16
}
| CheckOption Bool
| ButtonOption
data OptionSpec
= HashSize Int
| Ponder Bool
| ClearHash
data SearchOptions = SearchOptions
{ SearchOptions -> [UnknownMove]
searchMoves :: [UnknownMove]
, SearchOptions -> Bool
infinite :: Bool
, SearchOptions -> Depth
targetDepth :: Depth
, SearchOptions -> Maybe Int
moveTime :: Maybe Int
, SearchOptions -> Maybe Int
whiteTime :: Maybe Int
, SearchOptions -> Maybe Int
whiteIncrement :: Maybe Int
, SearchOptions -> Maybe Int
blackTime :: Maybe Int
, SearchOptions -> Maybe Int
blackIncrement :: Maybe Int
, SearchOptions -> Maybe Int
movesUntilNextTime :: Maybe Int
, SearchOptions -> Maybe Int
findMate :: Maybe Int
, SearchOptions -> Maybe Word64
maxNodes :: Maybe Word64
}
data PositionSpec = PositionSpec
{ PositionSpec -> Position
initialPosition :: Position,
PositionSpec -> [UnknownMove]
moves :: [UnknownMove]
}
data UnknownMove = UnknownMove
{ UnknownMove -> Int
start :: Square,
UnknownMove -> Int
end :: Square,
UnknownMove -> Promotion
promotion :: Promotion
}
engineInfo :: EngineInfo
engineInfo :: EngineInfo
engineInfo = EngineInfo
{ $sel:name:EngineInfo :: Text
name = Text
"Turncoat"
, $sel:version:EngineInfo :: Text
version = Text
"1.0"
, $sel:author:EngineInfo :: Text
author = Text
"Alberto Perez"
}
defaultEngineOptions :: EngineOptions
defaultEngineOptions :: EngineOptions
defaultEngineOptions = EngineOptions
{ $sel:hashSize:EngineOptions :: Word16
hashSize = Word16
16
, $sel:ponder:EngineOptions :: Bool
ponder = Bool
False
}
defaultSearchOptions :: SearchOptions
defaultSearchOptions :: SearchOptions
defaultSearchOptions = SearchOptions
{ $sel:searchMoves:SearchOptions :: [UnknownMove]
searchMoves = []
, $sel:infinite:SearchOptions :: Bool
infinite = Bool
False
, $sel:targetDepth:SearchOptions :: Depth
targetDepth = Depth
forall a. Bounded a => a
maxBound
, $sel:findMate:SearchOptions :: Maybe Int
findMate = Maybe Int
forall a. Maybe a
Nothing
, $sel:whiteTime:SearchOptions :: Maybe Int
whiteTime = Maybe Int
forall a. Maybe a
Nothing
, $sel:whiteIncrement:SearchOptions :: Maybe Int
whiteIncrement = Maybe Int
forall a. Maybe a
Nothing
, $sel:blackTime:SearchOptions :: Maybe Int
blackTime = Maybe Int
forall a. Maybe a
Nothing
, $sel:blackIncrement:SearchOptions :: Maybe Int
blackIncrement = Maybe Int
forall a. Maybe a
Nothing
, $sel:movesUntilNextTime:SearchOptions :: Maybe Int
movesUntilNextTime = Maybe Int
forall a. Maybe a
Nothing
, $sel:maxNodes:SearchOptions :: Maybe Word64
maxNodes = Maybe Word64
forall a. Maybe a
Nothing
, $sel:moveTime:SearchOptions :: Maybe Int
moveTime = Maybe Int
forall a. Maybe a
Nothing
}
instance Show EngineOption where
show :: EngineOption -> String
show = \case
SpinOption {Word16
$sel:deflt:SpinOption :: EngineOption -> Word16
$sel:lo:SpinOption :: EngineOption -> Word16
$sel:hi:SpinOption :: EngineOption -> Word16
deflt :: Word16
lo :: Word16
hi :: Word16
..} -> String
"type spin" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" default " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Word16 -> String
forall a. Show a => a -> String
show Word16
deflt
String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" min " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Word16 -> String
forall a. Show a => a -> String
show Word16
lo String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" max " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Word16 -> String
forall a. Show a => a -> String
show Word16
hi
CheckOption Bool
deflt -> String
"type check" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" default " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ShowS
forall t. Textual t => t -> t
toLower (Bool -> String
forall a. Show a => a -> String
show Bool
deflt)
EngineOption
ButtonOption -> String
"type button"
type Task = Async ()