module Search.TimeManagement (MicroSeconds, getMoveTime, maybeTimeout, isTimeOver, (|-|))  where

import           AppPrelude                 hiding (timeout)
import           Evaluation.Parameters
import           Evaluation.ScoreBreakdown
import           Models.Command
import           Models.Piece
import           Models.Position

import           Control.Concurrent.Timeout (timeout)
import           Data.Time.Clock.System


getMoveTime :: SearchOptions -> Position -> Maybe MicroSeconds
getMoveTime :: SearchOptions -> Position -> Maybe MicroSeconds
getMoveTime SearchOptions {Bool
[UnknownMove]
Maybe Int
Maybe MicroSeconds
Depth
searchMoves :: [UnknownMove]
infinite :: Bool
targetDepth :: Depth
moveTime :: Maybe Int
whiteTime :: Maybe Int
whiteIncrement :: Maybe Int
blackTime :: Maybe Int
blackIncrement :: Maybe Int
movesUntilNextTime :: Maybe Int
findMate :: Maybe Int
maxNodes :: Maybe MicroSeconds
$sel:searchMoves:SearchOptions :: SearchOptions -> [UnknownMove]
$sel:infinite:SearchOptions :: SearchOptions -> Bool
$sel:targetDepth:SearchOptions :: SearchOptions -> Depth
$sel:moveTime:SearchOptions :: SearchOptions -> Maybe Int
$sel:whiteTime:SearchOptions :: SearchOptions -> Maybe Int
$sel:whiteIncrement:SearchOptions :: SearchOptions -> Maybe Int
$sel:blackTime:SearchOptions :: SearchOptions -> Maybe Int
$sel:blackIncrement:SearchOptions :: SearchOptions -> Maybe Int
$sel:movesUntilNextTime:SearchOptions :: SearchOptions -> Maybe Int
$sel:findMate:SearchOptions :: SearchOptions -> Maybe Int
$sel:maxNodes:SearchOptions :: SearchOptions -> Maybe MicroSeconds
..} Position {Phase
phase :: Phase
$sel:phase:Position :: Position -> Phase
phase, Color
color :: Color
$sel:color:Position :: Position -> Color
color} =
  Int -> MicroSeconds
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> MicroSeconds) -> (Int -> Int) -> Int -> MicroSeconds
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
1000) (Int -> MicroSeconds) -> Maybe Int -> Maybe MicroSeconds
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Maybe Int
moveTime Maybe Int -> Maybe Int -> Maybe Int
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Int
timeToMove)
  where
    timeToMove :: Maybe Int
timeToMove
      | Just Int
t <- Maybe Int
time
      , Just Int
i <- Maybe Int
inc
        = Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Int -> Int
forall a. Ord a => a -> a -> a
min (Int
t Int -> Int -> Int
forall a. Integral a => a -> a -> a
/ Int
2) (Int
3 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
t Int -> Int -> Int
forall a. Integral a => a -> a -> a
/ (Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
movesUntil) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
i))
      | Just Int
t <- Maybe Int
time
        = Int -> Maybe Int
forall a. a -> Maybe a
Just (Int
t Int -> Int -> Int
forall a. Integral a => a -> a -> a
/ Int
movesUntil)
      | Just Int
i <- Maybe Int
inc
        = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
i
      | Bool
otherwise
        = Maybe Int
forall a. Maybe a
Nothing
    (Maybe Int
time, Maybe Int
inc) = case Color
color of
      Color
White -> (Maybe Int
whiteTime, Maybe Int
whiteIncrement)
      Color
Black -> (Maybe Int
blackTime, Maybe Int
blackIncrement)
    movesUntil :: Int
movesUntil = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
movesUntilDefault Maybe Int
movesUntilNextTime
    movesUntilDefault :: Int
movesUntilDefault =
      let ?phase = ?phase::Phase
Phase
phase in Phase -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Phase -> Int) -> Phase -> Int
forall a b. (a -> b) -> a -> b
$ (?phase::Phase) => ScorePair -> Phase
ScorePair -> Phase
taperScore (Phase -> Phase -> ScorePair
ScorePair Phase
40 Phase
10)


maybeTimeout :: Maybe MicroSeconds -> IO () -> IO ()
maybeTimeout :: Maybe MicroSeconds -> IO () -> IO ()
maybeTimeout (Just MicroSeconds
duration) IO ()
action =
  Integer -> IO () -> IO (Maybe ())
forall α. Integer -> IO α -> IO (Maybe α)
timeout (MicroSeconds -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral MicroSeconds
duration) IO ()
action IO (Maybe ()) -> () -> IO ()
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> ()
maybeTimeout Maybe MicroSeconds
Nothing IO ()
action         =
  IO ()
action


isTimeOver :: SystemTime -> SystemTime -> Maybe MicroSeconds -> Bool
isTimeOver :: SystemTime -> SystemTime -> Maybe MicroSeconds -> Bool
isTimeOver SystemTime
endTime SystemTime
startTime (Just MicroSeconds
moveTime) =
  SystemTime
endTime SystemTime -> SystemTime -> MicroSeconds
|-| SystemTime
startTime MicroSeconds -> MicroSeconds -> Bool
forall a. Ord a => a -> a -> Bool
> MicroSeconds -> MicroSeconds
getTimeOver MicroSeconds
moveTime
isTimeOver SystemTime
_ SystemTime
_ Maybe MicroSeconds
Nothing =
  Bool
False


getTimeOver :: MicroSeconds -> MicroSeconds
getTimeOver :: MicroSeconds -> MicroSeconds
getTimeOver MicroSeconds
moveTime =
  MicroSeconds
moveTime MicroSeconds -> MicroSeconds -> MicroSeconds
forall a. Num a => a -> a -> a
* MicroSeconds
30 MicroSeconds -> MicroSeconds -> MicroSeconds
forall a. Integral a => a -> a -> a
/ MicroSeconds
100


infixl 9 |-|
(|-|) :: SystemTime -> SystemTime -> MicroSeconds
|-| :: SystemTime -> SystemTime -> MicroSeconds
(|-|) SystemTime
endTime SystemTime
startTime =
  SystemTime -> MicroSeconds
forall {a}. Integral a => SystemTime -> a
systemTimeToMicros SystemTime
endTime MicroSeconds -> MicroSeconds -> MicroSeconds
forall a. Num a => a -> a -> a
- SystemTime -> MicroSeconds
forall {a}. Integral a => SystemTime -> a
systemTimeToMicros SystemTime
startTime
  where
  systemTimeToMicros :: SystemTime -> a
systemTimeToMicros MkSystemTime {Int64
Word32
systemSeconds :: Int64
systemNanoseconds :: Word32
systemSeconds :: SystemTime -> Int64
systemNanoseconds :: SystemTime -> Word32
..} =
    Int64 -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
systemSeconds a -> a -> a
forall a. Num a => a -> a -> a
* a
1_000_000
    a -> a -> a
forall a. Num a => a -> a -> a
+ Word32 -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
systemNanoseconds a -> a -> a
forall a. Integral a => a -> a -> a
/ a
1000


type MicroSeconds = Word64