module Search.Quiescence (quiesceSearch) where

import           AppPrelude

import           Evaluation.Evaluation
import           Models.Move
import           Models.Position
import           Models.Score
import           MoveGen.MakeMove
import           MoveGen.MoveQueries
import           MoveGen.PieceCaptures
import           MoveGen.PositionQueries
import           MoveGen.PieceQuietMoves
import           Search.Perft

import           Control.Monad.State


quiesceSearch :: (?nodes :: IORef Word64)
  => Score -> Score -> Ply -> Position -> IO Score
quiesceSearch :: (?nodes::IORef Word64) =>
Score -> Score -> Ply -> Position -> IO Score
quiesceSearch !Score
alpha !Score
beta !Ply
ply !Position
pos

  | Score
standPat Score -> Score -> Bool
forall a. Ord a => a -> a -> Bool
>= Score
beta = Score -> IO Score
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Score
beta

  | Bool
otherwise       = do
      IORef Word64 -> (Word64 -> Word64) -> IO ()
forall (m :: * -> *) a. MonadIO m => IORef a -> (a -> a) -> m ()
modifyIORef' ?nodes::IORef Word64
IORef Word64
?nodes (Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
1)
      (Maybe Score
score, Score
finalAlpha) <- StateT Score IO (Maybe Score) -> Score -> IO (Maybe Score, Score)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT StateT Score IO (Maybe Score)
scoreState Score
newAlpha
      Score -> IO Score
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Score -> IO Score) -> Score -> IO Score
forall a b. (a -> b) -> a -> b
$! Score -> Maybe Score -> Score
forall a. a -> Maybe a -> a
fromMaybe Score
finalAlpha Maybe Score
score
  where
    scoreState :: StateT Score IO (Maybe Score)
scoreState = (Int -> Move -> StateT Score IO (Maybe Score))
-> [Move] -> StateT Score IO (Maybe Score)
forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m (Maybe b)) -> [a] -> m (Maybe b)
findTraverseIndex ((?nodes::IORef Word64) =>
Score
-> Ply -> Position -> Int -> Move -> StateT Score IO (Maybe Score)
Score
-> Ply -> Position -> Int -> Move -> StateT Score IO (Maybe Score)
getMoveScore Score
beta Ply
ply Position
pos) [Move]
moves
    moves :: [Move]
moves
      | Position -> Bool
isKingInCheck Position
pos = Position -> [Move]
allMoves Position
pos
      | Ply
ply Ply -> Ply -> Bool
forall a. Ord a => a -> a -> Bool
<= Ply
1           = Position -> [Move]
getWinningCapturesAndChecks Position
pos
      | Bool
otherwise         = Position -> [Move]
getWinningCaptures Position
pos
    !newAlpha :: Score
newAlpha  = Score -> Score -> Score
forall a. Ord a => a -> a -> a
max Score
alpha Score
standPat
    !standPat :: Score
standPat  = Position -> Score
evaluatePosition Position
pos


getMoveScore :: (?nodes :: IORef Word64)
  => Score -> Ply -> Position -> Int -> Move -> QuiesceM (Maybe Score)
getMoveScore :: (?nodes::IORef Word64) =>
Score
-> Ply -> Position -> Int -> Move -> StateT Score IO (Maybe Score)
getMoveScore !Score
beta !Ply
ply !Position
pos Int
_ Move
mv =
  do !Score
alpha <- StateT Score IO Score
forall s (m :: * -> *). MonadState s m => m s
get
     !Score
score <- IO Score -> StateT Score IO Score
forall a. IO a -> StateT Score IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Score -> Score
forall a. Num a => a -> a
negate (Score -> Score) -> IO Score -> IO Score
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (?nodes::IORef Word64) =>
Score -> Score -> Ply -> Position -> IO Score
Score -> Score -> Ply -> Position -> IO Score
quiesceSearch (-Score
beta) (-Score
alpha)
                                               (Ply
ply Ply -> Ply -> Ply
forall a. Num a => a -> a -> a
+ Ply
1)
                                               (Move -> Position -> Position
makeMove Move
mv Position
pos))
     let !nodeType :: NodeType
nodeType = Score -> Score -> Score -> NodeType
getNodeType Score
alpha Score
beta Score
score
     Score -> Score -> NodeType -> StateT Score IO (Maybe Score)
advanceState Score
beta Score
score NodeType
nodeType


advanceState :: Score -> Score -> NodeType -> QuiesceM (Maybe Score)
advanceState :: Score -> Score -> NodeType -> StateT Score IO (Maybe Score)
advanceState !Score
beta !Score
score !NodeType
nodeType =
  case NodeType
nodeType of
    NodeType
PV  -> Maybe Score
forall a. Maybe a
Nothing Maybe Score -> StateT Score IO () -> StateT Score IO (Maybe Score)
forall a b. a -> StateT Score IO b -> StateT Score IO a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Score -> StateT Score IO ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put Score
score
    NodeType
Cut -> Maybe Score -> StateT Score IO (Maybe Score)
forall a. a -> StateT Score IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Score -> StateT Score IO (Maybe Score))
-> Maybe Score -> StateT Score IO (Maybe Score)
forall a b. (a -> b) -> a -> b
$ Score -> Maybe Score
forall a. a -> Maybe a
Just Score
beta
    NodeType
All -> Maybe Score -> StateT Score IO (Maybe Score)
forall a. a -> StateT Score IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Score
forall a. Maybe a
Nothing



getWinningCapturesAndChecks :: Position -> [Move]
getWinningCapturesAndChecks :: Position -> [Move]
getWinningCapturesAndChecks Position
pos =
  Position -> [Move]
getWinningCaptures Position
pos
    [Move] -> [Move] -> [Move]
forall a. Semigroup a => a -> a -> a
<> (Element [Move] -> Bool) -> [Move] -> [Move]
forall seq. IsSequence seq => (Element seq -> Bool) -> seq -> seq
filter (Move -> Position -> Bool
`isCheckMove` Position
pos) (Position -> [Move]
allQuietMoves Position
pos)


getWinningCaptures :: Position -> [Move]
getWinningCaptures :: Position -> [Move]
getWinningCaptures Position
pos =
  (Element [Move] -> Bool) -> [Move] -> [Move]
forall seq. IsSequence seq => (Element seq -> Bool) -> seq -> seq
filter (Move -> Position -> Bool
`isWinningCapture` Position
pos) (Position -> [Move]
allCaptures Position
pos)



type QuiesceM = StateT Score IO