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 ()