warnings

app/cboard.hs

@@ -8,7 +8,6 @@ import Control.Monad.Extra hiding (loop)
 import Control.Monad.IO.Class
 import Control.Monad.Random
 import Control.Monad.State.Strict
-import qualified Data.ByteString.Char8 as BS
 import Data.Char
 import Data.IORef
 import Data.List
@@ -19,7 +18,6 @@ import Game.Chess.UCI
 import System.Console.Haskeline hiding (catch, handle)
 import System.Exit
 import System.Environment
-import System.Random
 import Time.Units
 
 data S = S {

app/pgnio.hs

@@ -4,7 +4,6 @@ import Game.Chess.PGN
 import System.Environment
 import System.Exit
 import System.IO
-import Text.Megaparsec
 
 main :: IO ()
 main = getArgs >>= \case

app/polyplay.hs

@@ -15,7 +15,6 @@ import Game.Chess.PGN
 import Game.Chess.Polyglot.Book
 import Game.Chess.UCI
 import Options.Applicative
-import System.Environment
 import Time.Units
 
 data Clock = Clock !Color !NominalDiffTime !NominalDiffTime !UTCTime
@@ -32,14 +31,14 @@ flipClock clock = upd clock <$!> getCurrentTime where
 
 clockRemaining :: Clock -> Color -> IO (Maybe (Time Millisecond))
 clockRemaining (Clock c w b t) c'
-  | c == c' = case c of
-    White -> (\t' -> f $ w - (t' `diffUTCTime` t)) <$!> getCurrentTime
-    Black -> (\t' -> f $ b - (t' `diffUTCTime` t)) <$!> getCurrentTime
+  | c == c' = getCurrentTime >>= \t' -> pure $ case c of
+    White -> f $ w - (t' `diffUTCTime` t)
+    Black -> f $ b - (t' `diffUTCTime` t)
   | otherwise = pure $ case c' of
     White -> f w
     Black -> f b
  where
-  f x | x <= 0 = Nothing
+  f x | x <= 0    = Nothing
       | otherwise = Just . ms . fromRational . toRational $ x * 1000
 
 clockTimes :: Clock -> (Maybe (Time Millisecond), Maybe (Time Millisecond))
@@ -98,8 +97,8 @@ play b e !c = do
         (bmc, ic) <- search e [timeleft White wt, timeleft Black bt]
         sc <- newIORef Nothing
         itid <- liftIO . forkIO . forever $ do
-          info <- atomically . readTChan $ ic
-          case find isScore info of
+          i <- atomically . readTChan $ ic
+          case find isScore i of
             Just (Score s Nothing) -> writeIORef sc (Just s)
             _ -> pure ()
         (bm, _) <- atomically . readTChan $ bmc

src/Game/Chess/Polyglot/Book.hs

@@ -69,8 +69,10 @@ twic = fromByteString $(embedFile "book/twic-9g.bin")
 pv :: PolyglotBook -> [Ply]
 pv b = head . concatMap paths $ bookForest b startpos
 
-newtype PolyglotBook = Book (VS.Vector BookEntry)
+-- | A Polyglot opening book.
+newtype PolyglotBook = Book (VS.Vector BookEntry) deriving (Eq)
 
+-- | Create a PolyglotBook from a ByteString.
 fromByteString :: ByteString -> PolyglotBook
 fromByteString bs = Book v where
   v = VS.unsafeFromForeignPtr0 (plusForeignPtr fptr off) (len `div` elemSize)
@@ -89,11 +91,13 @@ paths = foldTree f where
   f a [] = [[a]]
   f a xs = (a :) <$> concat xs
 
+-- | Pick a random ply from the book.
 bookPly :: RandomGen g => PolyglotBook -> Position -> Maybe (Rand g Ply)
 bookPly b pos = case findPosition b pos of
   [] -> Nothing
   l -> Just . Rand.fromList $ map (ply &&& fromIntegral . weight) l
 
+-- | Probe the book for all plies known for the given position.
 bookPlies :: PolyglotBook -> Position -> [Ply]
 bookPlies b pos
   | halfMoveClock pos > 150 = []
@@ -111,4 +115,4 @@ findPosition (Book v) pos = fmap conv . VS.toList .
     | lo >= hi   = lo
     | x <= f mid = bsearch f (lo, mid) x
     | otherwise  = bsearch f (mid + 1, hi) x
-   where mid = (lo + hi) `div` 2
+   where mid = lo + ((hi - lo) `div` 2)

src/Game/Chess/QuadBitboard.hs

@@ -29,15 +29,15 @@ module Game.Chess.QuadBitboard (
 , whitePromotion, blackPromotion, whitePromotion', blackPromotion'
 ) where
 
-import Control.Applicative hiding (empty)
+import Control.Applicative (liftA2)
 import Data.Binary
 import Data.Bits
-import Data.Char
+import Data.Char (ord, toLower)
 import Data.Ix
-import Data.List
-import Data.String
+import Data.List (groupBy, intercalate)
+import Data.String (IsString(..))
 import GHC.Enum
-import Numeric
+import Numeric (showHex)
 
 data QuadBitboard = QBB { black :: {-# UNPACK #-} !Word64
                         , pbq :: {-# UNPACK #-} !Word64
@@ -47,8 +47,8 @@ data QuadBitboard = QBB { black :: {-# UNPACK #-} !Word64
 
 occupied, pnr, white, pawns, knights, bishops, rooks, queens, kings
   :: QuadBitboard -> Word64
-occupied QBB{pbq, nbk, rqk} = pbq .|. nbk .|. rqk
-pnr QBB{pbq, nbk, rqk}      = pbq `xor` nbk `xor` rqk
+occupied QBB{pbq, nbk, rqk} = pbq  .|.  nbk  .|.  rqk
+pnr      QBB{pbq, nbk, rqk} = pbq `xor` nbk `xor` rqk
 white = liftA2 xor occupied black
 
 pawns   = liftA2 (.&.) pnr pbq
@@ -191,8 +191,8 @@ instance Monoid QuadBitboard where
 -- | bitwise XOR
 instance Semigroup QuadBitboard where
   {-# INLINE (<>) #-}
-  QBB bb0 bb1 bb2 bb3 <> QBB bb0' bb1' bb2' bb3' =
-    QBB (bb0 `xor` bb0') (bb1 `xor` bb1') (bb2 `xor` bb2') (bb3 `xor` bb3')
+  QBB b0 b1 b2 b3 <> QBB b0' b1' b2' b3' =
+    QBB (b0 `xor` b0') (b1 `xor` b1') (b2 `xor` b2') (b3 `xor` b3')
 
 instance Show QuadBitboard where
   show QBB{..} =
@@ -204,11 +204,13 @@ instance Show QuadBitboard where
 toString :: QuadBitboard -> String
 toString qbb = intercalate "/" $ rank <$> [7, 6..0] where
   rank r = concatMap countEmpty . groupBy spaces $ charAt r <$> [0..7]
-  countEmpty xs = if head xs == ' ' then show $ length xs else xs
-  spaces x y = x == y && x == ' '
-  charAt r f = maybe ' ' (if odd nb then toLower else id) $
+  countEmpty xs | head xs == spc = show $ length xs
+                | otherwise      = xs
+  spaces x y = x == y && x == spc
+  charAt r f = maybe spc (if odd nb then toLower else id) $
     lookup (nb `div` 2) $ zip [1..] "PNBRQK"
    where nb = qbb ! (r*8+f)
+  spc = ' '
 
 -- | Move a nibble.  Note that this function, while convenient, isn't very
 -- fast as it needs to lookup the source nibble value.

src/Game/Chess/UCI.hs

@@ -352,14 +352,14 @@ setOptionSpinButton n v c
     send c $ "setoption name " <> byteString n <> " value " <> intDec v
     pure $ c { options = HashMap.update (set v) n $ options c }
  where
-  set v opt@SpinButton{} = Just $ opt { spinButtonValue = v }
+  set val opt@SpinButton{} = Just $ opt { spinButtonValue = val }
 
 setOptionString :: MonadIO m => ByteString -> ByteString -> Engine -> m Engine
 setOptionString n v e = liftIO $ do
   send e $ "setoption name " <> byteString n <> " value " <> byteString v
   pure $ e { options = HashMap.update (set v) n $ options e }
  where
-  set v _ = Just $ OString v
+  set val _ = Just $ OString val
 
 -- | Return the final position of the currently active game.
 currentPosition :: MonadIO m => Engine -> m Position

stack.yaml

@@ -1,4 +1,4 @@
-resolver: lts-13.19
+resolver: lts-13.21
 packages:
 - .
 extra-deps: