diff --git a/app/cboard.hs b/app/cboard.hs
--- a/app/cboard.hs
+++ b/app/cboard.hs
@@ -1,25 +1,32 @@
 module Main where
 
+import Control.Arrow ((&&&))
 import Control.Concurrent
 import Control.Concurrent.STM
-import Control.Exception
 import Control.Monad
+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
-import Data.List.Split
+import Data.List.Extra
 import Game.Chess
-import qualified Game.Chess.UCI as UCI
+import Game.Chess.Polyglot.Book (PolyglotBook, defaultBook, readPolyglotFile, bookPlies, bookPly)
+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 {
-  engine :: UCI.Engine
+  engine :: Engine
 , mover :: Maybe ThreadId
-, hintRef :: IORef (Maybe Move)
+, book :: PolyglotBook
+, hintRef :: IORef (Maybe Ply)
 }
 
 main :: IO ()
@@ -27,20 +34,20 @@
   [] -> do
     putStrLn "Please specify a UCI engine at the command line"
     exitWith $ ExitFailure 1
-  (cmd:args) -> UCI.start cmd args >>= \case
+  (cmd:args) -> start cmd args >>= \case
     Nothing -> do
       putStrLn "Unable to initialise engine, maybe it doesn't speak UCI?"
       exitWith $ ExitFailure 2
     Just e -> do
-      s <- S e Nothing <$> newIORef Nothing
+      s <- S e Nothing defaultBook <$> newIORef Nothing
       runInputT (setComplete (completeSAN e) defaultSettings) chessIO `evalStateT` s
       exitSuccess
 
-completeSAN :: MonadIO m => UCI.Engine -> CompletionFunc m
+completeSAN :: MonadIO m => Engine -> CompletionFunc m
 completeSAN e = completeWord Nothing "" $ \w ->
   fmap (map mkCompletion . filter (w `isPrefixOf`)) $ do
-    pos <- liftIO $ UCI.currentPosition e
-    pure $ unsafeToSAN pos <$> moves pos
+    pos <- currentPosition e
+    pure $ unsafeToSAN pos <$> legalPlies pos
  where
   mkCompletion s = (simpleCompletion s) { isFinished = False }
 
@@ -51,24 +58,36 @@
     , "Enter a FEN string to set the starting position."
     , "To make a move, enter a SAN or UCI string."
     , "Type \"hint\" to ask for a suggestion."
+    , "Type \"pass\" to let the engine make the next move, \"stop\" to end the search."
     , "Empty input will redraw the board."
     , "Hit Ctrl-D to quit."
     , ""
     ]
-  externalPrint <- getExternalPrint
-  e <- lift $ gets engine
-  hr <- lift $ gets hintRef
-  tid <- liftIO . forkIO $ doBestMove externalPrint hr e
-  lift $ modify' $ \s -> s { mover = Just tid }
   outputBoard
   loop
-  void . liftIO $ UCI.quit e
+  lift (gets engine) >>= void . quit
 
+midgame :: InputT (StateT S IO) ()
+midgame = do
+  e <- lift $ gets engine
+  b <- lift $ gets book
+  pos <- currentPosition e
+  case bookPly b pos of
+    Just r -> do
+      pl <- liftIO . evalRandIO $ r
+      addPly e pl
+      (bmc, _) <- search e [movetime (ms 100)]
+      liftIO $ do
+        (bm, _) <- atomically . readTChan $ bmc
+        addPly e bm
+      midgame
+    Nothing -> outputBoard
+
 outputBoard :: InputT (StateT S IO) ()
 outputBoard = do
   e <- lift $ gets engine
   liftIO $ do
-    pos <- UCI.currentPosition e
+    pos <- currentPosition e
     printBoard putStrLn pos
 
 loop :: InputT (StateT S IO) ()
@@ -79,22 +98,102 @@
     Just input
       | null input -> outputBoard *> loop
       | Just position <- fromFEN input -> do
-        liftIO $ UCI.setPosition e position
-        outputBoard *> loop
-      | input == "hint" -> do
+        void $ setPosition e position
+        outputBoard
+        loop
+      | "hint" == input -> do
         lift (gets hintRef) >>= liftIO . readIORef >>= \case
           Just hint -> do
-            pos <- liftIO $ UCI.currentPosition e
+            pos <- currentPosition e
             outputStrLn $ "Try " <> toSAN pos hint
           Nothing -> outputStrLn "Sorry, no hint available"
         loop
+      | "pass" == input -> do
+        unlessM (searching e) $ do
+          (bmc, _) <- search e [movetime (sec 2)]
+          hr <- lift $ gets hintRef
+          externalPrint <- getExternalPrint
+          tid <- liftIO . forkIO $ doBestMove externalPrint hr bmc e
+          lift $ modify' $ \s -> s { mover = Just tid }
+        loop
+      | input `elem` ["analyze", "analyse"] -> do
+        unlessM (searching e) $ do
+          pos <- currentPosition e
+          (bmc, ic) <- search e [infinite]
+          externalPrint <- getExternalPrint
+          itid <- liftIO . forkIO . forever $ do
+            info <- atomically . readTChan $ ic
+            case (find isScore &&& find isPV) info of
+              (Just (Score s Nothing), Just (PV pv)) ->
+                externalPrint $ show s <> ": " <> varToString pos pv
+              _ -> pure ()
+          tid <- liftIO . forkIO $ do
+            (bm, ponder) <- atomically . readTChan $ bmc
+            killThread itid
+            pos <- currentPosition e
+            externalPrint $ "Best move: " <> toSAN pos bm
+          lift $ modify' $ \s -> s { mover = Just tid }
+        loop
+      | "stop" == input -> do
+        stop e
+        loop
+      | ["polyglot", file] <- words input -> do
+        b <- liftIO $ readPolyglotFile file
+        lift $ modify $ \x -> x { book = b }
+        loop
+      | "book" == input -> do
+        b <- lift $ gets book
+        pos <- currentPosition e
+        let plies = bookPlies b pos
+        if not . null $ plies
+          then do
+            addPly e (head plies)
+            outputBoard
+            (bmc, _) <- search e [movetime (sec 1)]
+            hr <- lift $ gets hintRef
+            externalPrint <- getExternalPrint
+            tid <- liftIO . forkIO $ doBestMove externalPrint hr bmc e
+            lift $ modify' $ \s -> s { mover = Just tid }
+          else pure ()
+        loop
+      | "midgame" == input -> do
+        void $ setPosition e startpos
+        midgame
+        loop
       | otherwise -> do
-        liftIO $ printUCIException `handle` do
-          UCI.move e input
-          UCI.send "go movetime 1000" e
-        outputBoard
+        pos <- currentPosition e
+        case parseMove pos input of
+          Left err -> outputStrLn err
+          Right m -> ifM (searching e) (outputStrLn "Not your move") $ do
+            addPly e m
+            outputBoard
+            (bmc, _) <- search e [movetime (sec 1)]
+            hr <- lift $ gets hintRef
+            externalPrint <- getExternalPrint
+            tid <- liftIO . forkIO $ doBestMove externalPrint hr bmc e
+            lift $ modify' $ \s -> s { mover = Just tid }
         loop
 
+varToString :: Position -> [Ply] -> String
+varToString _ [] = ""
+varToString pos ms
+  | color pos == Black && length ms == 1
+  = show (moveNumber pos) <> "..." <> toSAN pos (head ms)
+  | color pos == Black
+  = show (moveNumber pos) <> "..." <> toSAN pos (head ms) <> " " <> fromWhite (doPly pos (head ms)) (tail ms)
+  | otherwise
+  = fromWhite pos ms
+ where
+  fromWhite pos = unwords . concat
+                . zipWith f [moveNumber pos ..] . chunksOf 2 . snd
+                . mapAccumL (curry (uncurry doPly &&& uncurry toSAN)) pos
+  f n (x:xs) = (show n <> "." <> x):xs
+
+parseMove :: Position -> String -> Either String Ply
+parseMove pos s = case fromUCI pos s of
+  Just m -> pure m
+  Nothing -> fromSAN pos s
+
 printBoard :: (String -> IO ()) -> Position -> IO ()
 printBoard externalPrint pos = externalPrint . init . unlines $
   (map . map) pc (reverse $ chunksOf 8 [A1 .. H8])
@@ -115,25 +214,28 @@
     Nothing | isDark sq -> '.'
             | otherwise -> ' '
 
-doBestMove :: (String -> IO ()) -> IORef (Maybe Move) -> UCI.Engine -> IO ()
-doBestMove externalPrint hintRef e = forever $ do
-  (bm, ponder) <- atomically . UCI.readBestMove $ e
-  pos <- UCI.currentPosition e
+doBestMove :: (String -> IO ())
+           -> IORef (Maybe Ply)
+           -> TChan (Ply, Maybe Ply)
+           -> Engine
+           -> IO ()
+doBestMove externalPrint hintRef bmc e = do
+  (bm, ponder) <- atomically . readTChan $ bmc
+  pos <- currentPosition e
   externalPrint $ "< " <> toSAN pos bm
-  UCI.addMove e bm
-  UCI.currentPosition e >>= printBoard externalPrint
+  addPly e bm
+  currentPosition e >>= printBoard externalPrint
   writeIORef hintRef ponder
 
-printPV :: (String -> IO ()) -> UCI.Engine -> IO ()
-printPV externalPrint engine = forever $ do
-  info <- atomically . UCI.readInfo $ engine
+printPV :: (String -> IO ()) -> TChan [Info] -> IO ()
+printPV externalPrint ic = forever $ do
+  info <- atomically . readTChan $ ic
   case find isPV info of
     Just pv -> externalPrint $ show pv
     Nothing -> pure ()
- where
-  isPV UCI.PV{} = True
-  isPV _        = False
 
-printUCIException :: UCI.UCIException -> IO ()
-printUCIException (UCI.SANError e) = putStrLn e
-printUCIException (UCI.IllegalMove m) = putStrLn $ "Illegal move: " <> show m
+isPV, isScore :: Info -> Bool
+isPV PV{}       = True
+isPV _          = False
+isScore Score{} = True
+isScore _       = False
diff --git a/app/pgnio.hs b/app/pgnio.hs
new file mode 100644
--- /dev/null
+++ b/app/pgnio.hs
@@ -0,0 +1,18 @@
+module Main where
+
+import Game.Chess.PGN
+import System.Environment
+import System.Exit
+import System.IO
+import Text.Megaparsec
+
+main :: IO ()
+main = getArgs >>= \case
+  [fp] -> readPGNFile fp >>= \case
+    Right pgn -> do
+      hPutPGN stdout breadthFirst pgn
+      exitSuccess
+    Left err -> do
+      hPutStr stderr err
+      exitWith (ExitFailure 1)
+  _ -> hPutStrLn stderr "Specify PGN file as argument"
diff --git a/app/polyplay.hs b/app/polyplay.hs
new file mode 100644
--- /dev/null
+++ b/app/polyplay.hs
@@ -0,0 +1,133 @@
+module Main where
+
+import Control.Concurrent
+import Control.Concurrent.STM
+import Control.Monad
+import Control.Monad.Random
+import Data.IORef
+import Data.List
+import Data.String
+import Data.Text.Prettyprint.Doc.Render.Text
+import Data.Time.Clock
+import Data.Tree
+import Game.Chess
+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
+
+newClock :: Int -> IO Clock
+newClock s = Clock White (fromIntegral s') (fromIntegral s') <$!> getCurrentTime
+  where
+ s' = s `div` 2
+
+flipClock :: Clock -> IO Clock
+flipClock clock = upd clock <$!> getCurrentTime where
+  upd (Clock White w b t) t' = Clock Black (w - (t' `diffUTCTime` t)) b t'
+  upd (Clock Black w b t) t' = Clock White w (b - (t' `diffUTCTime` t)) t'
+
+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
+  | otherwise = pure $ case c' of
+    White -> f w
+    Black -> f b
+ where
+  f x | x <= 0 = Nothing
+      | otherwise = Just . ms . fromRational . toRational $ x * 1000
+
+clockTimes :: Clock -> (Maybe (Time Millisecond), Maybe (Time Millisecond))
+clockTimes (Clock _ w b _) = (f w, f b) where
+  f x = if x <= 0 then Nothing else Just . ms . fromRational . toRational $ x * 1000
+
+data Polyplay = Polyplay {
+  hashSize :: Int
+, threadCount :: Int
+, tbPath :: Maybe FilePath
+, timeControl :: Int
+, bookFile :: FilePath
+, engineProgram :: FilePath
+, engineArgs :: [String]
+}
+
+opts :: Parser Polyplay
+opts = Polyplay <$> option auto (long "hash" <> metavar "MB" <> value 1024)
+                <*> option auto (long "threads" <> metavar "N" <> value 1)
+                <*> optional (strOption $ long "tbpath" <> metavar "PATH")
+                <*> option auto (long "time" <> metavar "SECONDS" <> value 600)
+                <*> argument str (metavar "BOOK")
+                <*> argument str (metavar "ENGINE")
+                <*> many (argument str (metavar "ARG"))
+
+main :: IO ()
+main = run =<< execParser (info (opts <**> helper) mempty)
+
+run :: Polyplay -> IO ()
+run Polyplay{..} = do
+  b <- readPolyglotFile bookFile
+  start engineProgram engineArgs >>= \case
+    Nothing -> putStrLn "Engine failed to start."
+    Just e -> do
+      _ <- setOptionSpinButton "Hash" hashSize e
+      _ <- setOptionSpinButton "Threads" threadCount e
+      case tbPath of
+        Just fp -> void $ setOptionString "SyzygyPath" (fromString fp) e
+        Nothing -> pure ()
+      isready e
+      (h, o) <- play b e =<< newClock timeControl
+      let g = gameFromForest [ ("White", "Stockfish")
+                             , ("Black", "Stockfish")
+                             ] (toForest h) o
+      putDoc (gameDoc breadthFirst g)
+      pure ()
+
+play :: PolyglotBook -> Engine -> Clock -> IO ([Ply], Outcome)
+play b e !c = do
+  pos <- currentPosition e
+  case legalPlies pos of
+    [] -> lost e
+    _ -> case bookPly b pos of
+      Nothing -> do
+        let (Just wt, Just bt) = clockTimes c
+        (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
+            Just (Score s Nothing) -> writeIORef sc (Just s)
+            _ -> pure ()
+        (bm, _) <- atomically . readTChan $ bmc
+        killThread itid
+        c' <- flipClock c
+        clockRemaining c' (color pos) >>= \case
+          Nothing -> lost e
+          Just _ -> do
+            addPly e bm
+            s <- readIORef sc
+            putStrLn $ toSAN pos bm <> " " <> show s
+            play b e c'
+      Just r -> do
+        pl <- evalRandIO r
+        putStrLn $ toSAN pos pl
+        addPly e pl
+        play b e =<< flipClock c
+
+lost :: Engine -> IO ([Ply], Outcome)
+lost e = do
+  pos <- currentPosition e
+  (_, h) <- setPosition e startpos
+  pure (h, Win . opponent . color $ pos)
+
+toForest :: [Ply] -> Forest Ply
+toForest [] = []
+toForest (x:xs) = [Node x $ toForest xs]
+
+isScore :: Info -> Bool
+isScore Score{} = True
+isScore _ = False
diff --git a/book/twic-9g.bin b/book/twic-9g.bin
new file mode 100644
# file too large to diff: book/twic-9g.bin
diff --git a/chessIO.cabal b/chessIO.cabal
--- a/chessIO.cabal
+++ b/chessIO.cabal
@@ -4,12 +4,12 @@
 --
 -- see: https://github.com/sol/hpack
 --
--- hash: 599aad9935d6d4f50f3cc7799f7a98a7dda1a711826adbe805ab542e16f0affe
+-- hash: dab466e43ec14aa8ef9e0f22f18879e7779c277908f0bf0c2acbfd77da80d0f3
 
 name:           chessIO
-version:        0.2.0.0
-synopsis:       Basic chess move generation and UCI client library
-description:    A simple library for generating legal chess moves. Also includes a module for communication with external processes that speak the UCI (Universal Chess Interface) protocol. On top of that, provides a console frontend program (cboard) that can be used to interactively play against UCI engines.
+version:        0.3.0.0
+synopsis:       Basic chess library
+description:    A simple library for generating legal chess moves. Also includes a module for communication with external processes that speak the UCI (Universal Chess Interface) protocol, a PGN parser/pretty printer, and Polyglot opening book support. On top of that, provides a console frontend program (cboard) that can be used to interactively play against UCI engines.
 category:       Game
 homepage:       https://github.com/mlang/chessIO#readme
 bug-reports:    https://github.com/mlang/chessIO/issues
@@ -21,6 +21,7 @@
 build-type:     Simple
 extra-source-files:
     README.rst
+    book/twic-9g.bin
 
 source-repository head
   type: git
@@ -29,21 +30,31 @@
 library
   exposed-modules:
       Game.Chess
+      Game.Chess.PGN
+      Game.Chess.Polyglot.Book
+      Game.Chess.Polyglot.Hash
       Game.Chess.UCI
   other-modules:
       Paths_chessIO
   hs-source-dirs:
       src
-  default-extensions: BangPatterns BinaryLiterals BlockArguments DeriveGeneric LambdaCase NamedFieldPuns NumericUnderscores RecordWildCards OverloadedStrings TupleSections ViewPatterns
+  default-extensions: BangPatterns BinaryLiterals BlockArguments DeriveGeneric FlexibleContexts GeneralizedNewtypeDeriving LambdaCase MultiParamTypeClasses NamedFieldPuns NumericUnderscores RecordWildCards OverloadedStrings TupleSections TypeApplications TypeFamilies ViewPatterns
   ghc-options: -Wall -O2
   build-depends:
-      attoparsec
-    , base >=4.8 && <5
+      MonadRandom
+    , attoparsec
+    , base >=4.10 && <5
     , bytestring
+    , containers
+    , file-embed
     , megaparsec
+    , o-clock
     , parser-combinators
+    , prettyprinter
     , process
+    , random
     , stm
+    , text
     , unordered-containers
     , vector
   default-language: Haskell2010
@@ -54,24 +65,89 @@
       Paths_chessIO
   hs-source-dirs:
       app
-  default-extensions: BangPatterns BinaryLiterals BlockArguments DeriveGeneric LambdaCase NamedFieldPuns NumericUnderscores RecordWildCards OverloadedStrings TupleSections ViewPatterns
+  default-extensions: BangPatterns BinaryLiterals BlockArguments DeriveGeneric FlexibleContexts GeneralizedNewtypeDeriving LambdaCase MultiParamTypeClasses NamedFieldPuns NumericUnderscores RecordWildCards OverloadedStrings TupleSections TypeApplications TypeFamilies ViewPatterns
   ghc-options: -Wall -O2 -threaded
   build-depends:
-      attoparsec
-    , base >=4.8 && <5
+      MonadRandom
+    , attoparsec
+    , base >=4.10 && <5
     , bytestring
     , chessIO
+    , containers
+    , extra
+    , file-embed
     , haskeline
     , megaparsec
     , mtl
+    , o-clock
     , parser-combinators
+    , prettyprinter
     , process
-    , split
+    , random
     , stm
+    , text
     , unordered-containers
     , vector
   default-language: Haskell2010
 
+executable pgnio
+  main-is: pgnio.hs
+  other-modules:
+      Paths_chessIO
+  hs-source-dirs:
+      app
+  default-extensions: BangPatterns BinaryLiterals BlockArguments DeriveGeneric FlexibleContexts GeneralizedNewtypeDeriving LambdaCase MultiParamTypeClasses NamedFieldPuns NumericUnderscores RecordWildCards OverloadedStrings TupleSections TypeApplications TypeFamilies ViewPatterns
+  ghc-options: -Wall -O2
+  build-depends:
+      MonadRandom
+    , attoparsec
+    , base >=4.10 && <5
+    , bytestring
+    , chessIO
+    , containers
+    , file-embed
+    , megaparsec
+    , o-clock
+    , parser-combinators
+    , prettyprinter
+    , process
+    , random
+    , stm
+    , text
+    , unordered-containers
+    , vector
+  default-language: Haskell2010
+
+executable polyplay
+  main-is: polyplay.hs
+  other-modules:
+      Paths_chessIO
+  hs-source-dirs:
+      app
+  default-extensions: BangPatterns BinaryLiterals BlockArguments DeriveGeneric FlexibleContexts GeneralizedNewtypeDeriving LambdaCase MultiParamTypeClasses NamedFieldPuns NumericUnderscores RecordWildCards OverloadedStrings TupleSections TypeApplications TypeFamilies ViewPatterns
+  ghc-options: -Wall -O2
+  build-depends:
+      MonadRandom
+    , attoparsec
+    , base >=4.10 && <5
+    , bytestring
+    , chessIO
+    , containers
+    , file-embed
+    , megaparsec
+    , o-clock
+    , optparse-applicative
+    , parser-combinators
+    , prettyprinter
+    , process
+    , random
+    , stm
+    , text
+    , time
+    , unordered-containers
+    , vector
+  default-language: Haskell2010
+
 test-suite perft
   type: exitcode-stdio-1.0
   main-is: Perft.hs
@@ -79,19 +155,26 @@
       Paths_chessIO
   hs-source-dirs:
       test
-  default-extensions: BangPatterns BinaryLiterals BlockArguments DeriveGeneric LambdaCase NamedFieldPuns NumericUnderscores RecordWildCards OverloadedStrings TupleSections ViewPatterns
+  default-extensions: BangPatterns BinaryLiterals BlockArguments DeriveGeneric FlexibleContexts GeneralizedNewtypeDeriving LambdaCase MultiParamTypeClasses NamedFieldPuns NumericUnderscores RecordWildCards OverloadedStrings TupleSections TypeApplications TypeFamilies ViewPatterns
   ghc-options: -Wall -O2 -threaded -rtsopts "-with-rtsopts=-N -s"
   build-depends:
-      attoparsec
-    , base >=4.8 && <5
+      MonadRandom
+    , attoparsec
+    , base >=4.10 && <5
     , bytestring
     , chessIO
+    , containers
     , directory
+    , file-embed
     , megaparsec
+    , o-clock
     , parallel
     , parser-combinators
+    , prettyprinter
     , process
+    , random
     , stm
+    , text
     , time
     , unordered-containers
     , vector
diff --git a/src/Game/Chess.hs b/src/Game/Chess.hs
--- a/src/Game/Chess.hs
+++ b/src/Game/Chess.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE PolyKinds, FlexibleInstances, TypeSynonymInstances, GADTs, ScopedTypeVariables #-}
 {-|
 Module      : Game.Chess
 Description : Basic data types and functions related to the game of chess
@@ -18,121 +19,263 @@
   -- * Chess positions
   Color(..), opponent
 , Sq(..), isLight, isDark
-, PieceType(..)
-, Position, startpos, color, pieceAt, inCheck
+, PieceType(..), Castle(..)
+, Position, startpos, color, moveNumber, halfMoveClock, pieceAt, inCheck
+, castlingRights, canCastleKingside, canCastleQueenside
   -- ** Converting from/to Forsyth-Edwards-Notation
 , fromFEN, toFEN
   -- * Chess moves
-, Move
+, Ply(..)
   -- ** Converting from/to algebraic notation
-, fromSAN, toSAN, unsafeToSAN, fromUCI, toUCI
+, strictSAN, relaxedSAN, fromSAN, toSAN, unsafeToSAN, fromUCI, toUCI, fromPolyglot
   -- ** Move generation
-, moves
+, legalPlies
   -- ** Executing moves
-, applyMove, unsafeApplyMove
+, doPly, unsafeDoPly
 ) where
 
+import Control.Applicative
 import Control.Applicative.Combinators
 import Data.Bits
+import qualified Data.ByteString as Strict (ByteString)
+import qualified Data.ByteString.Lazy as Lazy (ByteString)
 import Data.Char
 import Data.Functor (($>))
 import Data.Ix
 import Data.List
 import Data.Maybe
+import Data.Ord (Down(..))
+import Data.Proxy
+import Data.String
+import qualified Data.Text as Strict (Text)
+import qualified Data.Text.Lazy as Lazy (Text)
 import Data.Vector.Unboxed (Vector, (!))
 import Data.Void
 import qualified Data.Vector.Unboxed as Vector
 import Data.Word
 import Text.Megaparsec
-import Text.Megaparsec.Char
-import Text.Read
+import Text.Read (readMaybe)
+import Data.Tree
 
-type Parser = Parsec Void String
+positionTree :: Position -> Tree Position
+positionTree pos = Node pos $ positionForest pos
+positionForest :: Position -> Forest Position
+positionForest pos = positionTree . unsafeDoPly pos <$> legalPlies pos
+plyForest :: Position -> Forest Ply
+plyForest pos = plyTree pos <$> legalPlies pos
+plyTree :: Position -> Ply -> Tree Ply
+plyTree pos ply = Node ply . plyForest $ unsafeDoPly pos ply
 
+type Parser s = Parsec Void s
+
+castling :: (Stream s, IsString (Tokens s))
+         => Position -> Parser s Ply
+castling pos
+  | ccks && ccqs = queenside <|> kingside
+  | ccks = kingside
+  | ccqs = queenside
+  | otherwise = empty
+ where
+  ccks = canCastleKingside pos
+  ccqs = canCastleQueenside pos
+  kingside = chunk "O-O" $> castleMove Kingside
+  queenside = chunk "O-O-O" $> castleMove Queenside
+  castleMove Kingside | color pos == White = wKscm
+                      | otherwise          = bKscm
+  castleMove Queenside | color pos == White = wQscm
+                       | otherwise          = bQscm
+
 data From = File Int
           | Rank Int
           | Square Int
           deriving (Show)
 
-san :: Parser (PieceType, Maybe From, Bool, Int, Maybe PieceType, Maybe Char)
-san = conv <$> piece
-           <*> location
-           <*> optional (optional (char '=') *> promo)
-           <*> optional (char '+' <|> char '#') where
-  conv pc (Nothing, Nothing, cap, to) = (pc, Nothing, cap, to,,)
-  conv pc (Just f, Nothing, cap, to) = (pc, Just (File f), cap, to,,)
-  conv pc (Nothing, Just r, cap, to) = (pc, Just (Rank r), cap, to,,)
-  conv pc (Just f, Just r, cap, to) = (pc, Just (Square (r*8+f)), cap, to,,)
-  piece = char 'N' $> Knight
-      <|> char 'B' $> Bishop
-      <|> char 'R' $> Rook
-      <|> char 'Q' $> Queen
-      <|> char 'K' $> King
-      <|> pure Pawn
-  location = try ((,,,) <$> (Just <$> file)
-                        <*> pure Nothing
-                        <*> capture
-                        <*> square)
-         <|> try ((,,,) <$> pure Nothing
-                        <*> (Just <$> rank)
-                        <*> capture
-                        <*> square)
-         <|> try ((,,,) <$> (Just <$> file)
-                        <*> (Just <$> rank)
-                        <*> capture
-                        <*> square)
-         <|>      (,,,) <$> pure Nothing
-                        <*> pure Nothing
-                        <*> capture
-                        <*> square
-  promo = char 'N' $> Knight
-      <|> char 'B' $> Bishop
-      <|> char 'R' $> Rook
-      <|> char 'Q' $> Queen
-  capture = option False $ char 'x' $> True
-  square = frToInt <$> file <*> rank
-  file = subtract (ord 'a') . ord <$> oneOf ['a'..'h']
-  rank = subtract (ord '1') . ord <$> oneOf ['1'..'8']
-  frToInt f r = r*8 + f
+capturing :: Position -> Ply -> Maybe PieceType
+capturing pos@Position{flags} (unpack -> (_, to, _))
+  | (flags .&. epMask) `testBit` to = Just Pawn
+  | otherwise = snd <$> pieceAt pos to
 
-fromSAN :: Position -> String -> Either String Move
-fromSAN Position{color = White, flags} s
-  | s `elem` ["O-O", "0-0"] && flags `testMask` crwKs = Right wKscm
-fromSAN Position{color = Black, flags} s
-  | s `elem` ["O-O", "0-0"] && flags `testMask` crbKs = Right bKscm
-fromSAN Position{color = White, flags} s
-  | s `elem` ["O-O-O", "0-0-0"] && flags `testMask` crwQs = Right wQscm
-fromSAN Position{color = Black, flags} s
-  | s `elem` ["O-O-O", "0-0-0"] && flags `testMask` crbQs = Right bQscm
-fromSAN pos s = case parse san "" s of
-  Right (pc, from, _, to, promo, _) ->
-    case ms pc from to promo of
-      [m] -> Right m
-      [] -> Left "Illegal move"
-      _ -> Left "Ambiguous move"
-  Left err -> Left $ errorBundlePretty err
+isCapture :: Position -> Ply -> Bool
+isCapture pos = isJust . capturing pos
+
+data SANStatus = Check | Checkmate deriving (Eq, Read, Show)
+
+class SANToken a where
+  sanPieceToken :: a -> Maybe PieceType
+  fileToken :: a -> Maybe Int
+  rankToken :: a -> Maybe Int
+  promotionPieceToken :: a -> Maybe PieceType
+  statusToken :: a -> Maybe SANStatus
+
+sanPiece :: (Stream s, SANToken (Token s)) => Parser s PieceType
+sanPiece = token sanPieceToken mempty <?> "piece"
+
+fileP, rankP, squareP :: (Stream s, SANToken (Token s)) => Parser s Int
+fileP = token fileToken mempty <?> "file"
+rankP = token rankToken mempty <?> "rank"
+squareP = liftA2 (\f r -> r*8+f) fileP rankP <?> "square"
+
+promotionPiece :: (Stream s, SANToken (Token s)) => Parser s PieceType
+promotionPiece = token promotionPieceToken mempty <?> "Q, R, B, N"
+
+sanStatus :: (Stream s, SANToken (Token s)) => Parser s SANStatus
+sanStatus = token statusToken mempty <?> "+, #"
+
+instance SANToken Char where
+  sanPieceToken = \case
+    'N' -> Just Knight
+    'B' -> Just Bishop
+    'R' -> Just Rook
+    'Q' -> Just Queen
+    'K' -> Just King
+    _ -> Nothing
+  fileToken c | c >= 'a' && c <= 'h' = Just $ ord c - ord 'a'
+              | otherwise  = Nothing
+  rankToken c | c >= '1' && c <= '8' = Just $ ord c - ord '1'
+              | otherwise  = Nothing
+  promotionPieceToken = \case
+    'N' -> Just Knight
+    'B' -> Just Bishop
+    'R' -> Just Rook
+    'Q' -> Just Queen
+    _ -> Nothing
+  statusToken = \case
+    '+' -> Just Check
+    '#' -> Just Checkmate
+    _ -> Nothing
+
+instance SANToken Word8 where
+  sanPieceToken = \case
+    78 -> Just Knight
+    66 -> Just Bishop
+    82 -> Just Rook
+    81 -> Just Queen
+    75 -> Just King
+    _ -> Nothing
+  rankToken c | c >= 49 && c <= 56 = Just . fromIntegral $ c - 49
+              | otherwise  = Nothing
+  fileToken c | c >= 97 && c <= 104 = Just . fromIntegral $ c - 97
+              | otherwise  = Nothing
+  promotionPieceToken = \case
+    78 -> Just Knight
+    66 -> Just Bishop
+    82 -> Just Rook
+    81 -> Just Queen
+    _ -> Nothing
+  statusToken = \case
+    43 -> Just Check
+    35 -> Just Checkmate
+    _ -> Nothing
+
+strictSAN :: forall s. (Stream s, SANToken (Token s), IsString (Tokens s))
+          => Position -> Parser s Ply
+strictSAN pos = case legalPlies pos of
+  [] -> fail "No legal moves in this position"
+  ms -> (castling pos <|> normal ms) >>= checkStatus
  where
-  ms pc from to prm = filter (f from) $ moves pos where
-   f (Just (Square from)) (unpack -> (from', to', prm')) =
-     pAt from' == pc && from' == from && to' == to && prm' == prm
-   f (Just (File ff)) (unpack -> (from', to', prm')) =
-     pAt from' == pc && from' `mod` 8 == ff && to == to' && prm == prm'
-   f (Just (Rank fr)) (unpack -> (from', to', prm')) =
-     pAt from' == pc && from' `div` 8 == fr && to == to' && prm == prm'
-   f Nothing (unpack -> (from', to', prm')) =
-     pAt from' == pc && to == to' && prm == prm'
-  pAt = snd . fromJust . pieceAt pos . toEnum
+  normal ms = do
+    p <- sanPiece <|> pure Pawn
+    case filter (pieceFrom p) ms of
+      [] -> fail $ show (color pos) <> " has no " <> show p <> " which could be moved"
+      ms' -> target p ms'
+  pieceFrom p (moveFrom -> from) = p == snd (fromJust (pieceAt pos from))
+  moveFrom (unpack -> (from, _, _)) = from
+  target p ms = coords p ms >>= \m@(unpack -> (_, to, _)) -> case p of
+    Pawn | lastRank to -> promoteTo m <$> promotion
+    _ -> pure m
+  coords p ms = choice $ fmap (uncurry (<$) . fmap chunk) $
+    sortOn (Down . chunkLength (Proxy :: Proxy s) . snd) $
+    (\m -> (m, sanCoords pos (p,ms) m)) <$> ms
+  promotion = chunk "=" *> promotionPiece
+  lastRank i = i >= 56 || i <= 7
+  checkStatus m
+    | inCheck (color nextPos) nextPos && null (legalPlies nextPos)
+    = chunk "#" $> m
+    | inCheck (color nextPos) nextPos
+    = chunk "+" $> m
+    | otherwise
+    = pure m
+   where
+    nextPos = unsafeDoPly pos m
 
-toSAN :: Position -> Move -> String
-toSAN pos m | m `elem` moves pos = unsafeToSAN pos m
+relaxedSAN :: (Stream s, SANToken (Token s), IsString (Tokens s))
+           => Position -> Parser s Ply
+relaxedSAN pos = (castling pos <|> normal) <* optional sanStatus where
+  normal = do
+    pc <- sanPiece <|> pure Pawn
+    (from, _, to) <- conv <$> location
+    prm <- optional $ optional (chunk "=") *> promotionPiece
+    case possible pc from to prm of
+      [m] -> pure m
+      [] -> fail "Illegal move"
+      _ -> fail "Ambiguous move"
+  conv (Nothing, Nothing, cap, to) = (Nothing, cap, to)
+  conv (Just f, Nothing, cap, to) = (Just (File f), cap, to)
+  conv (Nothing, Just r, cap, to) = (Just (Rank r), cap, to)
+  conv (Just f, Just r, cap, to) = (Just (Square (r*8+f)), cap, to)
+  location = try ((,Nothing,,) <$> (Just <$> fileP) <*> capture <*> squareP)
+         <|> try ((Nothing,,,) <$> (Just <$> rankP) <*> capture <*> squareP)
+         <|> try ((,,,) <$> (Just <$> fileP) <*> (Just <$> rankP)
+                        <*> capture <*> squareP)
+         <|>      (Nothing,Nothing,,) <$> capture <*> squareP
+  capture = option False $ chunk "x" $> True
+  ms = legalPlies pos
+  possible pc from to prm = filter (f from) ms where
+    f (Just (Square from)) (unpack -> (from', to', prm')) =
+      pAt from' == pc && from' == from && to' == to && prm' == prm
+    f (Just (File ff)) (unpack -> (from', to', prm')) =
+      pAt from' == pc && from' `mod` 8 == ff && to == to' && prm == prm'
+    f (Just (Rank fr)) (unpack -> (from', to', prm')) =
+      pAt from' == pc && from' `div` 8 == fr && to == to' && prm == prm'
+    f Nothing (unpack -> (from', to', prm')) =
+      pAt from' == pc && to == to' && prm == prm'
+  pAt = snd . fromJust . pieceAt pos
+
+fromSAN :: (Stream s, SANToken (Token s), IsString (Tokens s))
+        => Position -> s -> Either String Ply
+fromSAN pos s = case parse (relaxedSAN pos) "" s of
+  Right m -> Right m
+  Left err -> Left $ errorBundlePretty err
+
+toSAN :: Position -> Ply -> String
+toSAN pos m | m `elem` legalPlies pos = unsafeToSAN pos m
             | otherwise          = error "Game.Chess.toSAN: Illegal move"
 
-unsafeToSAN :: Position -> Move -> String
-unsafeToSAN pos@Position{flags} m@(unpack -> (from, to, promo)) =
+sanCoords :: IsString s => Position -> (PieceType, [Ply]) -> Ply -> s
+sanCoords pos (pc,lms) m@(unpack -> (from, to, _)) =
+  fromString $ source <> target
+ where
+  capture = isCapture pos m
+  source
+    | pc == Pawn && capture
+    = [fileChar from]
+    | pc == Pawn
+    = []
+    | length ms == 1
+    = []
+    | length (filter fEq ms) == 1
+    = [fileChar from]
+    | length (filter rEq ms) == 1
+    = [rankChar from]
+    | otherwise
+    = toCoord from
+  target
+    | capture = "x" <> toCoord to
+    | otherwise = toCoord to
+  ms = filter (isMoveTo to) lms
+  isMoveTo to (unpack -> (_, to', _)) = to == to'
+  fEq (unpack -> (from', _, _)) = from' `mod` 8 == fromFile
+  rEq (unpack -> (from', _, _)) = from' `div` 8 == fromRank
+  (fromRank, fromFile) = toRF from
+  fileChar i = chr $ (i `mod` 8) + ord 'a'
+  rankChar i = chr $ (i `div` 8) + ord '1'
+
+unsafeToSAN :: Position -> Ply -> String
+unsafeToSAN pos m@(unpack -> (from, to, promo)) =
   moveStr <> status
  where
   moveStr = case piece of
-    Pawn | isCapture -> fileChar from : target <> promotion
+    Pawn | capture -> fileChar from : target <> promotion
          | otherwise -> target <> promotion
     King | color pos == White && m == wKscm -> "O-O"
          | color pos == White && m == wQscm -> "O-O-O"
@@ -143,38 +286,37 @@
     Bishop -> 'B' : source <> target
     Rook   -> 'R' : source <> target
     Queen  -> 'Q' : source <> target
-  piece = fromJust $ snd <$> pieceAt pos (toEnum from)
-  isCapture = isJust (pieceAt pos $ toEnum to) || (flags .&. epMask) `testBit` to
+  piece = fromJust $ snd <$> pieceAt pos from
+  capture = isCapture pos m
   source
     | length ms == 1              = []
     | length (filter fEq ms) == 1 = [fileChar from]
     | length (filter rEq ms) == 1 = [rankChar from]
-    | otherwise                   = coord from
+    | otherwise                   = toCoord from
   target
-    | isCapture = 'x' : coord to
-    | otherwise = coord to
+    | capture = "x" <> toCoord to
+    | otherwise = toCoord to
   promotion = case promo of
     Just Knight -> "N"
     Just Bishop -> "B"
     Just Rook   -> "R"
     Just Queen  -> "Q"
     _      -> ""
-  status | inCheck (color nextPos) nextPos && null (moves nextPos)
+  status | inCheck (color nextPos) nextPos && null (legalPlies nextPos)
          = "#"
          | inCheck (color nextPos) nextPos
          = "+"
          | otherwise
          = ""
-  nextPos = unsafeApplyMove pos m
-  ms = filter movesTo $ moves pos
+  nextPos = unsafeDoPly pos m
+  ms = filter movesTo $ legalPlies pos
   movesTo (unpack -> (from', to', _)) =
-    fmap snd (pieceAt pos (toEnum from')) == Just piece && to' == to
+    fmap snd (pieceAt pos from') == Just piece && to' == to
   fEq (unpack -> (from', _, _)) = from' `mod` 8 == fromFile
   rEq (unpack -> (from', _, _)) = from' `div` 8 == fromRank
-  (fromRank, fromFile) = from `divMod` 8
+  (fromRank, fromFile) = toRF from
   fileChar i = chr $ (i `mod` 8) + ord 'a'
   rankChar i = chr $ (i `div` 8) + ord '1'
-  coord i = let (r,f) = i `divMod` 8 in chr (f + ord 'a') : [chr (r + ord '1')]
 
 -- | The starting position as given by the FEN string
 --   "rnbqkbnr/pppppppp/8/8/8/8/PPPPPPPP/RNBQKBNR w KQkq - 0 1".
@@ -182,12 +324,12 @@
 startpos = fromJust $
   fromFEN "rnbqkbnr/pppppppp/8/8/8/8/PPPPPPPP/RNBQKBNR w KQkq - 0 1"
 
-data PieceType = Pawn | Knight | Bishop | Rook | Queen | King deriving (Eq, Show)
+data PieceType = Pawn | Knight | Bishop | Rook | Queen | King deriving (Eq, Ix, Ord, Show)
 
-data Color = White | Black deriving (Eq, Show)
+data Color = Black | White deriving (Eq, Ix, Ord, Show)
 
-pieceAt :: Position -> Sq -> Maybe (Color, PieceType)
-pieceAt (board -> BB{wP, wN, wB, wR, wQ, wK, bP, bN, bB, bR, bQ, bK}) (fromEnum -> sq)
+pieceAt :: IsSquare sq => Position -> sq -> Maybe (Color, PieceType)
+pieceAt (board -> BB{wP, wN, wB, wR, wQ, wK, bP, bN, bB, bR, bQ, bK}) (toIndex -> sq)
   | wP `testBit` sq = Just (White, Pawn)
   | wN `testBit` sq = Just (White, Knight)
   | wB `testBit` sq = Just (White, Bishop)
@@ -216,14 +358,28 @@
         | A6 | B6 | C6 | D6 | E6 | F6 | G6 | H6
         | A7 | B7 | C7 | D7 | E7 | F7 | G7 | H7
         | A8 | B8 | C8 | D8 | E8 | F8 | G8 | H8
-        deriving (Bounded, Enum, Eq, Show)
+        deriving (Bounded, Enum, Eq, Ix, Ord, Show)
 
-isDark :: Sq -> Bool
-isDark (fromEnum -> sq) = (0xaa55aa55aa55aa55 :: Word64) `testBit` sq
+class IsSquare sq where
+  toIndex :: sq -> Int
 
-isLight :: Sq -> Bool
+toRF :: IsSquare sq => sq -> (Int, Int)
+toRF sq = toIndex sq `divMod` 8
+
+toCoord :: (IsSquare sq, IsString s) => sq -> s
+toCoord (toRF -> (r,f)) = fromString [chr (f + ord 'a'), chr (r + ord '1')]
+
+instance IsSquare Sq where
+  toIndex = fromEnum
+
+instance IsSquare Int where
+  toIndex = id
+
+isDark :: IsSquare sq => sq -> Bool
+isDark (toIndex -> sq) = (0xaa55aa55aa55aa55 :: Word64) `testBit` sq
+
+isLight :: IsSquare sq => sq -> Bool
 isLight = not . isDark
-data Castling = Kingside | Queenside deriving (Eq, Ord, Show)
 
 data BB = BB { wP, wN, wB, wR, wQ, wK :: !Word64
              , bP, bN, bB, bR, bQ, bK :: !Word64
@@ -232,11 +388,16 @@
 data Position = Position {
   board :: !BB
 , color :: !Color
+  -- ^ active color
 , flags :: !Word64
 , halfMoveClock :: !Int
 , moveNumber :: !Int
-} deriving (Eq)
+  -- ^ number of the full move
+}
 
+instance Eq Position where
+  a == b = board a == board b && color a == color b && flags a == flags b
+
 emptyBB :: BB
 emptyBB = BB 0 0 0 0 0 0 0 0 0 0 0 0
 
@@ -253,7 +414,7 @@
              <*> readMaybe (parts !! 5)
  where
   parts = words fen
-  readBoard = go (sqToRF A8) emptyBB where
+  readBoard = go (toRF A8) emptyBB where
     go rf@(r,f) bb ('r':s) = go (r, f + 1) (bb { bR = bR bb .|. rfBit rf }) s
     go rf@(r,f) bb ('n':s) = go (r, f + 1) (bb { bN = bN bb .|. rfBit rf }) s
     go rf@(r,f) bb ('b':s) = go (r, f + 1) (bb { bB = bB bb .|. rfBit rf }) s
@@ -297,9 +458,6 @@
       = Just $ bit ((ord r - ord '1') * 8 + (ord f - ord 'a'))
     readEP _ = Nothing
 
-sqToRF :: Sq -> (Int, Int)
-sqToRF sq = fromEnum sq `divMod` 8
-
 rfBit :: Bits bits => (Int, Int) -> bits
 rfBit (r,f) | inRange (0,7) r && inRange (0,7) f = bit $ r*8 + f
             | otherwise = error $ "Out of range: " <> show r <> " " <> show f
@@ -325,7 +483,7 @@
                 | otherwise          = (v, xs)
   showEP 0 = "-"
   showEP x = chr (f + ord 'a') : [chr (r + ord '1')] where
-    (r, f) = bitScanForward x `divMod` 8
+    (r, f) = toRF $ bitScanForward x
   rank r = concatMap countEmpty $ groupBy (\x y -> x == y && x == ' ') $
            charAt r <$> [0..7]
   countEmpty xs | head xs == ' ' = show $ length xs
@@ -358,33 +516,34 @@
 
 foldBits :: (a -> Int -> a) -> a -> Word64 -> a
 foldBits _ a 0 = a
-foldBits f !a n = foldBits f (f a lsb) (n `xor` (1 `unsafeShiftL` lsb)) where
+foldBits f !a n = foldBits f (f a lsb) (n .&. (n-1)) where
   !lsb = countTrailingZeros n
 
 bitScanForward, bitScanReverse :: Word64 -> Int
 bitScanForward = countTrailingZeros
 bitScanReverse = (63 -) . countLeadingZeros
 
-newtype Move = Move Word16 deriving (Eq)
+newtype Ply = Ply Word16 deriving (Eq)
 
-instance Show Move where
+instance Show Ply where
   show = toUCI
 
-move :: Int -> Int -> Move
-move from to = Move $ fromIntegral from .|. fromIntegral to `unsafeShiftL` 6
+move :: (IsSquare from, IsSquare to) => from -> to -> Ply
+move (toIndex -> from) (toIndex -> to) =
+  Ply $ fromIntegral to .|. fromIntegral from `unsafeShiftL` 6
 
-promoteTo :: Move -> PieceType -> Move
-promoteTo (Move x) = Move . set where
-  set Knight = x .|. 0b001_000000_000000
-  set Bishop = x .|. 0b010_000000_000000
-  set Rook   = x .|. 0b011_000000_000000
-  set Queen  = x .|. 0b100_000000_000000
+promoteTo :: Ply -> PieceType -> Ply
+promoteTo (Ply x) = Ply . set where
+  set Knight = x .&. 0xfff .|. 0x1000
+  set Bishop = x .&. 0xfff .|. 0x2000
+  set Rook   = x .&. 0xfff .|. 0x3000
+  set Queen  = x .&. 0xfff .|. 0x4000
   set _      = x
 
-unpack :: Move -> (Int, Int, Maybe PieceType)
-unpack (Move x) = ( fromIntegral (x .&. 0b111111)
-                  , fromIntegral ((x `unsafeShiftR` 6) .&. 0b111111)
-                  , piece)
+unpack :: Ply -> (Int, Int, Maybe PieceType)
+unpack (Ply x) = ( fromIntegral ((x `unsafeShiftR` 6) .&. 0b111111)
+                 , fromIntegral (x .&. 0b111111)
+                 , piece)
  where
   !piece = case x `unsafeShiftR` 12 of
     1 -> Just Knight
@@ -393,8 +552,20 @@
     4 -> Just Queen
     _ -> Nothing
 
+fromPolyglot :: Position -> Ply -> Ply
+fromPolyglot pos pl@(unpack -> (from, to, _)) = case color pos of
+  White | from == toIndex E1 && canCastleKingside pos && to == toIndex H1
+          -> from `move` G1
+        | from == toIndex E1 && canCastleQueenside pos && to == toIndex A1
+          -> from `move` C1
+  Black | from == toIndex E8 && canCastleKingside pos && to == toIndex H8
+          -> from `move` G8
+        | from == toIndex E8 && canCastleQueenside pos && to == toIndex A8
+          -> from `move` C8
+  _ -> pl
+
 -- | Parse a move in the format used by the Universal Chess Interface protocol.
-fromUCI :: Position -> String -> Maybe Move
+fromUCI :: Position -> String -> Maybe Ply
 fromUCI pos (fmap (splitAt 2) . splitAt 2 -> (from, (to, promo)))
   | length from == 2 && length to == 2 && null promo
   = move <$> readCoord from <*> readCoord to >>= relativeTo pos
@@ -416,9 +587,9 @@
 fromUCI _ _ = Nothing
 
 -- | Convert a move to the format used by the Universal Chess Interface protocol.
-toUCI :: Move -> String
+toUCI :: Ply -> String
 toUCI (unpack -> (from, to, promo)) = coord from <> coord to <> p where
-  coord x = let (r,f) = x `divMod` 8 in
+  coord x = let (r,f) = toRF x in
             chr (f + ord 'a') : [chr (r + ord '1')]
   p = case promo of
     Just Queen -> "q"
@@ -428,8 +599,8 @@
     _ -> ""
 
 -- | Validate that a certain move is legal in the given position.
-relativeTo :: Position -> Move -> Maybe Move
-relativeTo pos m | m `elem` moves pos = Just m
+relativeTo :: Position -> Ply -> Maybe Ply
+relativeTo pos m | m `elem` legalPlies pos = Just m
                  | otherwise = Nothing
 
 shiftN, shiftNNE, shiftNE, shiftENE, shiftE, shiftESE, shiftSE, shiftSSE, shiftS, shiftSSW, shiftSW, shiftWSW, shiftW, shiftWNW, shiftNW, shiftNNW :: Word64 -> Word64
@@ -453,225 +624,220 @@
 -- | Apply a move to the given position.
 --
 -- This function checks if the move is actually legal and throws and error
--- if it isn't.  See 'unsafeApplyMove' for a version that omits the legality check.
-applyMove :: Position -> Move -> Position
-applyMove p m
-  | m `elem` moves p = unsafeApplyMove p m
-  | otherwise        = error "Game.Chess.applyMove: Illegal move"
+-- if it isn't.  See 'unsafeDoPly' for a version that omits the legality check.
+doPly :: Position -> Ply -> Position
+doPly p m
+  | m `elem` legalPlies p = unsafeDoPly p m
+  | otherwise        = error "Game.Chess.doPly: Illegal move"
 
--- | An unsafe version of 'applyMove'.  Only use this if you are sure the given move
+-- | An unsafe version of 'doPly'.  Only use this if you are sure the given move
 -- can be applied to the position.  This is useful if the move has been generated
 -- by the 'moves' function.
-unsafeApplyMove :: Position -> Move -> Position
-unsafeApplyMove pos@Position{flags} m@(unpack -> (from, to, promo))
+unsafeDoPly :: Position -> Ply -> Position
+unsafeDoPly pos@Position{color = White, halfMoveClock} m =
+  (unsafeDoPly' pos m) { color = Black, halfMoveClock = succ halfMoveClock }
+unsafeDoPly pos@Position{color = Black, moveNumber, halfMoveClock} m =
+  (unsafeDoPly' pos m) { color = White, moveNumber = succ moveNumber, halfMoveClock = succ halfMoveClock }
+
+unsafeDoPly' :: Position -> Ply -> Position
+unsafeDoPly' pos@Position{board, flags} m@(unpack -> (from, to, promo))
   | m == wKscm && flags `testMask` crwKs
-  = pos { board = bb { wK = wK bb `xor` mask
-                     , wR = wR bb `xor` (bit (fromEnum H1) `setBit` fromEnum F1)
-                     }
-        , color = opponent (color pos)
+  = pos { board = board { wK = wK board `xor` mask
+                        , wR = wR board `xor` (bit (toIndex H1) `setBit` toIndex F1)
+                        }
         , flags = flags `clearMask` (rank1 .|. epMask)
         }
   | m == wQscm && flags `testMask` crwQs
-  = pos { board = bb { wK = wK bb `xor` mask
-                     , wR = wR bb `xor` (bit (fromEnum A1) `setBit` fromEnum D1)
-                     }
-        , color = opponent (color pos)
+  = pos { board = board { wK = wK board `xor` mask
+                        , wR = wR board `xor` (bit (toIndex A1) `setBit` toIndex D1)
+                        }
         , flags = flags `clearMask` (rank1 .|. epMask)
         }
   | m == bKscm && flags `testMask` crbKs
-  = pos { board = bb { bK = bK bb `xor` mask
-                     , bR = bR bb `xor` (bit (fromEnum H8) `setBit` fromEnum F8)
-                     }
-        , color = opponent (color pos)
+  = pos { board = board { bK = bK board `xor` mask
+                        , bR = bR board `xor` (bit (toIndex H8) `setBit` toIndex F8)
+                        }
         , flags = flags `clearMask` (rank8 .|. epMask)
         }
   | m == bQscm && flags `testMask` crbQs
-  = pos { board = bb { bK = bK bb `xor` mask
-                     , bR = bR bb `xor` (bit (fromEnum A8) `setBit` fromEnum D8)
-                     }
-        , color = opponent (color pos)
+  = pos { board = board { bK = bK board `xor` mask
+                        , bR = bR board `xor` (bit (toIndex A8) `setBit` toIndex D8)
+                        }
         , flags = flags `clearMask` (rank8 .|. epMask)
         }
-  | Just Queen <- promo
-  , color pos == White
-  = pos { board = clearB { wP = wP bb `clearBit` from
-                         , wQ = wQ bb `setBit` to
-                         }
-        , color = opponent (color pos)
-        , flags = flags `clearMask` (epMask .|. bit to)
-        }
-  | Just Rook <- promo
-  , color pos == White
-  = pos { board = clearB { wP = wP bb `clearBit` from
-                         , wR = wR bb `setBit` to
-                         }
-        , color = opponent (color pos)
-        , flags = flags `clearMask` (epMask .|. bit to)
-        }
-  | Just Bishop <- promo
-  , color pos == White
-  = pos { board = clearB { wP = wP bb `clearBit` from
-                         , wB = wB bb `setBit` to
-                         }
-        , color = opponent (color pos)
-        , flags = flags `clearMask` (epMask .|. bit to)
-        }
-  | Just Knight <- promo
-  , color pos == White
-  = pos { board = clearB { wP = wP bb `clearBit` from
-                         , wN = wN bb `setBit` to
-                         }
-        , color = opponent (color pos)
-        , flags = flags `clearMask` (epMask .|. bit to)
-        }
-  | Just Queen <- promo
-  , color pos == Black
-  = pos { board = clearW { bP = bP bb `clearBit` from
-                         , bQ = bQ bb `setBit` to
-                         }
-        , color = opponent (color pos)
-        , flags = flags `clearMask` (epMask .|. bit to)
-        }  
-  | Just Rook <- promo
-  , color pos == Black
-  = pos { board = clearW { bP = bP bb `clearBit` from
-                         , bR = bR bb `setBit` to
-                         }
-        , color = opponent (color pos)
-        , flags = flags `clearMask` (epMask .|. bit to)
-        }
-  | Just Bishop <- promo
-  , color pos == Black
-  = pos { board = clearW { bP = bP bb `clearBit` from
-                         , bB = bB bb `setBit` to
-                         }
-        , color = opponent (color pos)
-        , flags = flags `clearMask` (epMask .|. bit to)
-        }
-  | Just Knight <- promo
-  , color pos == Black
-  = pos { board = clearW { bP = bP bb `clearBit` from
-                         , bN = bN bb `setBit` to
-                         }
-        , color = opponent (color pos)
-        , flags = flags `clearMask` (epMask .|. bit to)
-        }
+  | Just piece <- promo
+  = case color pos of
+      White -> case piece of
+        Queen -> pos { board = clearB { wP = wP board `clearBit` from
+                                      , wQ = wQ board `setBit` to
+                                      }
+                     , flags = flags `clearMask` (epMask .|. bit to)
+                     }
+        Rook  -> pos { board = clearB { wP = wP board `clearBit` from
+                                      , wR = wR board `setBit` to
+                                      }
+                     , flags = flags `clearMask` (epMask .|. bit to)
+                     }
+        Bishop -> pos { board = clearB { wP = wP board `clearBit` from
+                                       , wB = wB board `setBit` to
+                                       }
+                      , flags = flags `clearMask` (epMask .|. bit to)
+                      }
+        Knight -> pos { board = clearB { wP = wP board `clearBit` from
+                                       , wN = wN board `setBit` to
+                                       }
+                      , flags = flags `clearMask` (epMask .|. bit to)
+                      }
+        _ -> error "Impossible: White tried to promote to Pawn"
+      Black -> case piece of
+        Queen -> pos { board = clearW { bP = bP board `clearBit` from
+                                      , bQ = bQ board `setBit` to
+                                      }
+                     , flags = flags `clearMask` (epMask .|. bit to)
+                     }  
+        Rook   -> pos { board = clearW { bP = bP board `clearBit` from
+                                       , bR = bR board `setBit` to
+                                       }
+                      , flags = flags `clearMask` (epMask .|. bit to)
+                      }
+        Bishop -> pos { board = clearW { bP = bP board `clearBit` from
+                                       , bB = bB board `setBit` to
+                                       }
+                      , flags = flags `clearMask` (epMask .|. bit to)
+                      }
+        Knight -> pos { board = clearW { bP = bP board `clearBit` from
+                                       , bN = bN board `setBit` to
+                                       }
+                      , flags = flags `clearMask` (epMask .|. bit to)
+                      }
+        _ -> error "Impossible: Black tried to promote to Pawn"
   | otherwise
   = pos { board = newBoard
-        , color = opponent (color pos)
-        , flags = (flags `clearMask` (epMask .|. mask)) .|. dpp }
+        , flags = (flags `clearMask` (epMask .|. mask)) .|. dpp
+        }
  where
-  !bb = board pos
-  epBit = case color pos of
-    White | wP bb `testMask` fromMask -> shiftS $ flags .&. rank6 .&. toMask
-    Black | bP bb `testMask` fromMask -> shiftN $ flags .&. rank3 .&. toMask
+  !epBit = case color pos of
+    White | wP board `testMask` fromMask -> shiftS $ flags .&. rank6 .&. toMask
+    Black | bP board `testMask` fromMask -> shiftN $ flags .&. rank3 .&. toMask
     _ -> 0
-  clearW = bb { wP = wP bb `clearMask` (toMask .|. epBit)
-              , wN = wN bb `clearMask` toMask
-              , wB = wB bb `clearMask` toMask
-              , wR = wR bb `clearMask` toMask
-              , wQ = wQ bb `clearMask` toMask
-              }
-  clearB = bb { bP = bP bb `clearMask` (toMask .|. epBit)
-              , bN = bN bb `clearMask` toMask
-              , bB = bB bb `clearMask` toMask
-              , bR = bR bb `clearMask` toMask
-              , bQ = bQ bb `clearMask` toMask
-              }
+  clearW = board { wP = wP board `clearMask` (toMask .|. epBit)
+                 , wN = wN board `clearMask` toMask
+                 , wB = wB board `clearMask` toMask
+                 , wR = wR board `clearMask` toMask
+                 , wQ = wQ board `clearMask` toMask
+                 }
+  clearB = board { bP = bP board `clearMask` (toMask .|. epBit)
+                 , bN = bN board `clearMask` toMask
+                 , bB = bB board `clearMask` toMask
+                 , bR = bR board `clearMask` toMask
+                 , bQ = bQ board `clearMask` toMask
+                 }
   !fromMask = 1 `unsafeShiftL` from
   !toMask = 1 `unsafeShiftL` to
   !mask = fromMask .|. toMask
   newBoard = case color pos of
-    White | wP bb `testMask` fromMask -> clearB { wP = wP bb `xor` mask }
-          | wN bb `testMask` fromMask -> clearB { wN = wN bb `xor` mask }
-          | wB bb `testMask` fromMask -> clearB { wB = wB bb `xor` mask }
-          | wR bb `testMask` fromMask -> clearB { wR = wR bb `xor` mask }
-          | wQ bb `testMask` fromMask -> clearB { wQ = wQ bb `xor` mask }
-          | otherwise -> clearB { wK = wK bb `xor` mask }
-    Black | bP bb `testMask` fromMask -> clearW { bP = bP bb `xor` mask }
-          | bN bb `testMask` fromMask -> clearW { bN = bN bb `xor` mask }
-          | bB bb `testMask` fromMask -> clearW { bB = bB bb `xor` mask }
-          | bR bb `testMask` fromMask -> clearW { bR = bR bb `xor` mask }
-          | bQ bb `testMask` fromMask -> clearW { bQ = bQ bb `xor` mask }
-          | otherwise -> clearW { bK = bK bb `xor` mask }
+    White | wP board `testMask` fromMask -> clearB { wP = wP board `xor` mask }
+          | wN board `testMask` fromMask -> clearB { wN = wN board `xor` mask }
+          | wB board `testMask` fromMask -> clearB { wB = wB board `xor` mask }
+          | wR board `testMask` fromMask -> clearB { wR = wR board `xor` mask }
+          | wQ board `testMask` fromMask -> clearB { wQ = wQ board `xor` mask }
+          | otherwise -> clearB { wK = wK board `xor` mask }
+    Black | bP board `testMask` fromMask -> clearW { bP = bP board `xor` mask }
+          | bN board `testMask` fromMask -> clearW { bN = bN board `xor` mask }
+          | bB board `testMask` fromMask -> clearW { bB = bB board `xor` mask }
+          | bR board `testMask` fromMask -> clearW { bR = bR board `xor` mask }
+          | bQ board `testMask` fromMask -> clearW { bQ = bQ board `xor` mask }
+          | otherwise -> clearW { bK = bK board `xor` mask }
   dpp = case color pos of
-    White | fromMask .&. rank2 .&. wP bb /= 0 && from + 16 == to -> bit (from + 8)
-    Black | fromMask .&. rank7 .&. bP bb /= 0 && from - 16 == to -> bit (from - 8)
+    White | fromMask .&. rank2 .&. wP board /= 0 && from + 16 == to -> shiftN fromMask
+    Black | fromMask .&. rank7 .&. bP board /= 0 && from - 16 == to -> shiftS fromMask
     _                                                            -> 0
 
 -- | Generate a list of possible moves for the given position.
-moves :: Position -> [Move]
-moves pos@Position{color, board, flags} =
-  filter (not . inCheck color . unsafeApplyMove pos) $
-      kingMoves pos notOurs
+legalPlies :: Position -> [Ply]
+legalPlies pos@Position{color, board, flags} = filter legalPly $
+      kingMoves
     . knightMoves
-    . slideMoves Queen pos ours notOurs
-    . slideMoves Rook pos ours notOurs
-    . slideMoves Bishop pos ours notOurs
+    . slideMoves Queen pos ours notOurs occ
+    . slideMoves Rook pos ours notOurs occ
+    . slideMoves Bishop pos ours notOurs occ
     . pawnMoves
     $ []
  where
-  ours = occupiedBy color board 
-  notOurs = complement ours
-  (!pawnMoves, !knightMoves) = case color of
+  legalPly = not . inCheck color . unsafeDoPly' pos
+  !ours = occupiedBy color board
+  !them = occupiedBy (opponent color) board
+  !notOurs = complement ours
+  !occ = ours .|. them
+  (!pawnMoves, !knightMoves, !kingMoves) = case color of
     White ->
-      ( wPawnMoves (wP board) (notOccupied board) (occupiedBy Black board .|. (flags .&. epMask))
-      , flip (foldBits genNMoves) (wN board))
+      ( wPawnMoves (wP board) (complement occ) (them .|. (flags .&. epMask))
+      , flip (foldBits genNMoves) (wN board)
+      , flip (foldBits genKMoves) (wK board) . wShort . wLong)
     Black ->
-      ( bPawnMoves (bP board) (notOccupied board) (occupiedBy White board .|. (flags .&. epMask))
-      , flip (foldBits genNMoves) (bN board))
+      ( bPawnMoves (bP board) (complement occ) (them .|. (flags .&. epMask))
+      , flip (foldBits genNMoves) (bN board)
+      , flip (foldBits genKMoves) (bK board) . bShort . bLong)
   genNMoves ms sq = foldBits (mkM sq) ms ((knightAttacks ! sq) .&. notOurs)
-  mkM from ms to = move from to : ms
+  genKMoves ms sq = foldBits (mkM sq) ms ((kingAttacks ! sq) .&. notOurs)
+  wShort ml | canCastleKingside' pos occ = wKscm : ml
+            | otherwise             = ml
+  wLong ml  | canCastleQueenside' pos occ = wQscm : ml
+            | otherwise              = ml
+  bShort ml | canCastleKingside' pos occ = bKscm : ml
+            | otherwise             = ml
+  bLong ml  | canCastleQueenside' pos occ = bQscm : ml
+            | otherwise              = ml
+  mkM !from ms !to = move from to : ms
 
 -- | Returns 'True' if 'Color' is in check in the given position.
 inCheck :: Color -> Position -> Bool
-inCheck White Position{board} = attackedBy Black (bitScanForward (wK board)) board
-inCheck Black Position{board} = attackedBy White (bitScanForward (bK board)) board
+inCheck White Position{board} = attackedBy Black board (occupied board) (bitScanForward (wK board))
+inCheck Black Position{board} = attackedBy White board (occupied board) (bitScanForward (bK board))
 
-wPawnMoves :: Word64 -> Word64 -> Word64 -> [Move] -> [Move]
-wPawnMoves pawns emptySquares opponentPieces =
-    flip (foldBits $ mkMove 9) eastCaptureTargets
-  . flip (foldBits $ mkMove 7) westCaptureTargets
-  . flip (foldBits $ mkMove 8) singlePushTargets
-  . flip (foldBits $ mkMove 16) doublePushTargets
+wPawnMoves :: Word64 -> Word64 -> Word64 -> [Ply] -> [Ply]
+wPawnMoves !pawns !emptySquares !opponentPieces =
+    flip (foldBits $ mkPly 9) eastCaptureTargets
+  . flip (foldBits $ mkPly 7) westCaptureTargets
+  . flip (foldBits $ mkPly 8) singlePushTargets
+  . flip (foldBits $ mkPly 16) doublePushTargets
  where
   doublePushTargets = shiftN singlePushTargets .&. emptySquares .&. rank4
   singlePushTargets = shiftN pawns .&. emptySquares
   eastCaptureTargets = shiftNE pawns .&. opponentPieces
   westCaptureTargets = shiftNW pawns .&. opponentPieces
-  mkMove diff ms tsq
+  mkPly diff ms tsq
     | tsq >= 56 = (promoteTo m <$> [Queen, Rook, Bishop, Knight]) <> ms
     | otherwise = m : ms
    where m = move (tsq - diff) tsq
 
-bPawnMoves :: Word64 -> Word64 -> Word64 -> [Move] -> [Move]
-bPawnMoves pawns emptySquares opponentPieces =
-    flip (foldBits $ mkMove 9) westCaptureTargets
-  . flip (foldBits $ mkMove 7) eastCaptureTargets
-  . flip (foldBits $ mkMove 8) singlePushTargets
-  . flip (foldBits $ mkMove 16) doublePushTargets
+bPawnMoves :: Word64 -> Word64 -> Word64 -> [Ply] -> [Ply]
+bPawnMoves !pawns !emptySquares !opponentPieces =
+    flip (foldBits $ mkPly 9) westCaptureTargets
+  . flip (foldBits $ mkPly 7) eastCaptureTargets
+  . flip (foldBits $ mkPly 8) singlePushTargets
+  . flip (foldBits $ mkPly 16) doublePushTargets
  where
   doublePushTargets = shiftS singlePushTargets .&. emptySquares .&. rank5
   singlePushTargets = shiftS pawns .&. emptySquares
   eastCaptureTargets = shiftSE pawns .&. opponentPieces
   westCaptureTargets = shiftSW pawns .&. opponentPieces
-  mkMove diff ms tsq
+  mkPly diff ms tsq
     | tsq <= 7  = (promoteTo m <$> [Queen, Rook, Bishop, Knight]) <> ms
     | otherwise = m : ms
    where m = move (tsq + diff) tsq
 
-slideMoves :: PieceType -> Position -> Word64 -> Word64 -> [Move] -> [Move]
-slideMoves piece (Position bb c _ _ _) ours notOurs =
+slideMoves :: PieceType -> Position -> Word64 -> Word64 -> Word64 -> [Ply] -> [Ply]
+slideMoves piece (Position bb c _ _ _) !ours !notOurs !occ =
   flip (foldBits gen) pieces
  where
-  gen ms from = foldBits (mkMove from) ms (targets from)
-  mkMove from ms to = move from to : ms
+  gen ms from = foldBits (mkPly from) ms (targets from)
+  mkPly from ms to = move from to : ms
   targets sq = case piece of
     Rook -> rookTargets sq occ .&. notOurs
     Bishop -> bishopTargets sq occ .&. notOurs
     Queen -> queenTargets sq occ .&. notOurs
     _ -> error "Not a sliding piece"
-  occ = ours .|. occupiedBy (opponent c) bb
   pieces = case (c, piece) of
     (White, Bishop) -> wB bb
     (Black, Bishop) -> bB bb
@@ -681,47 +847,45 @@
     (Black, Queen)  -> bQ bb
     _ -> 0
 
-kingMoves :: Position -> Word64 -> [Move] -> [Move]
-kingMoves pos@Position{board, color} notOurs ml = case color of
-  White -> kMoves (wK board) . wCastleMoves pos $ ml
-  Black -> kMoves (bK board) . bCastleMoves pos $ ml
- where
-  kMoves = flip (foldBits gen)
-  gen ms sq = foldBits (mkMove sq) ms ((kingAttacks ! sq) .&. notOurs)
-  mkMove from ms to = move from to : ms
+data Castle = Kingside | Queenside deriving (Eq, Ix, Ord, Show)
 
-wCastleMoves, bCastleMoves :: Position -> [Move] -> [Move]
-wCastleMoves (Position board _ flags _ _) = short . long where
-  short ml | flags `testMask` crwKs && occupied board .&. crwKe == 0 &&
-             not (attackedBy Black (fromEnum E1) board) &&
-             not (attackedBy Black (fromEnum F1) board)
-           = wKscm : ml
-           | otherwise = ml
-  long ml  | flags `testMask` crwQs && occupied board .&. crwQe == 0 &&
-             not (attackedBy Black (fromEnum E1) board) &&
-             not (attackedBy Black (fromEnum D1) board)
-           = wQscm : ml
-           | otherwise = ml
-bCastleMoves (Position board _ flags _ _) = short . long where
-  short ml | flags `testMask` crbKs && occupied board .&. crbKe == 0 &&
-             not (attackedBy White (fromEnum E8) board) &&
-             not (attackedBy White (fromEnum F8) board)
-           = bKscm : ml
-           | otherwise = ml
-  long ml  | flags `testMask` crbQs && occupied board .&. crbQe == 0 &&
-             not (attackedBy White (fromEnum E8) board) &&
-             not (attackedBy White (fromEnum D8) board)
-           = bQscm : ml
-           | otherwise = ml
+castlingRights :: Position -> [(Color, Castle)]
+castlingRights Position{flags} = wks . wqs . bks . bqs $ [] where
+  wks xs | flags `testMask` crwKs = (White, Kingside):xs
+         | otherwise              = xs
+  wqs xs | flags `testMask` crwQs = (White, Queenside):xs
+         | otherwise              = xs
+  bks xs | flags `testMask` crbKs = (Black, Kingside):xs
+         | otherwise              = xs
+  bqs xs | flags `testMask` crbQs = (Black, Queenside):xs
+         | otherwise              = xs
 
-wKscm, wQscm, bKscm, bQscm :: Move
-wKscm = move (fromEnum E1) (fromEnum G1)
-wQscm = move (fromEnum E1) (fromEnum C1)
-bKscm = move (fromEnum E8) (fromEnum G8)
-bQscm = move (fromEnum E8) (fromEnum C8)
+canCastleKingside, canCastleQueenside :: Position -> Bool
+canCastleKingside !pos@Position{board} = canCastleKingside' pos (occupied board)
+canCastleQueenside !pos@Position{board} = canCastleQueenside' pos (occupied board)
 
-attackedBy :: Color -> Int -> BB -> Bool
-attackedBy White sq bb@BB{wP, wN, wB, wR, wQ, wK}
+canCastleKingside', canCastleQueenside' :: Position -> Word64 -> Bool
+canCastleKingside' Position{board, color = White, flags} !occ =
+  flags `testMask` crwKs && occ .&. crwKe == 0 &&
+  not (any (attackedBy Black board occ) [E1, F1, G1])
+canCastleKingside' Position{board, color = Black, flags} !occ = 
+  flags `testMask` crbKs && occ .&. crbKe == 0 &&
+  not (any (attackedBy White board occ) [E8, F8, G8])
+canCastleQueenside' Position{board, color = White, flags} !occ =
+  flags `testMask` crwQs && occ .&. crwQe == 0 &&
+  not (any (attackedBy Black board occ) [E1, D1, C1])
+canCastleQueenside' Position{board, color = Black, flags} !occ =
+  flags `testMask` crbQs && occ .&. crbQe == 0 &&
+  not (any (attackedBy White board occ) [E8, D8, C8])
+
+wKscm, wQscm, bKscm, bQscm :: Ply
+wKscm = move E1 G1
+wQscm = move E1 C1
+bKscm = move E8 G8
+bQscm = move E8 C8
+
+attackedBy :: IsSquare sq => Color -> BB -> Word64 -> sq -> Bool
+attackedBy White BB{wP, wN, wB, wR, wQ, wK} !occ (toIndex -> sq)
   | (wPawnAttacks ! sq) .&. wP /= 0 = True
   | (knightAttacks ! sq) .&. wN /= 0 = True
   | bishopTargets sq occ .&. wB /= 0 = True
@@ -729,8 +893,7 @@
   | queenTargets sq occ .&.  wQ /= 0 = True
   | (kingAttacks ! sq) .&. wK /= 0   = True
   | otherwise                        = False
- where occ = occupied bb
-attackedBy Black sq bb@BB{bP, bN, bB, bR, bQ, bK}
+attackedBy Black BB{bP, bN, bB, bR, bQ, bK} !occ (toIndex -> sq)
   | (bPawnAttacks ! sq) .&. bP /= 0 = True
   | (knightAttacks ! sq) .&. bN /= 0 = True
   | bishopTargets sq occ .&. bB /= 0 = True
@@ -738,7 +901,6 @@
   | queenTargets sq occ .&.  bQ /= 0 = True
   | (kingAttacks ! sq) .&. bK /= 0   = True
   | otherwise                        = False
- where occ = occupied bb
 
 notAFile, notABFile, notGHFile, notHFile, rank1, rank2, rank3, rank4, rank5, rank6, rank7, rank8 :: Word64
 notAFile = 0xfefefefefefefefe
@@ -825,10 +987,20 @@
 testMask a b = a .&. b == b
 
 {-# INLINE clearMask #-}
+{-# INLINE testMask #-}
 {-# INLINE attackedBy #-}
-{-# INLINE kingMoves #-}
 {-# INLINE slideMoves #-}
 {-# INLINE wPawnMoves #-}
 {-# INLINE bPawnMoves #-}
 {-# INLINE unpack #-}
 {-# INLINE foldBits #-}
+{-# SPECIALISE relaxedSAN :: Position -> Parser Strict.ByteString Ply #-}
+{-# SPECIALISE relaxedSAN :: Position -> Parser Lazy.ByteString Ply #-}
+{-# SPECIALISE relaxedSAN :: Position -> Parser Strict.Text Ply #-}
+{-# SPECIALISE relaxedSAN :: Position -> Parser Lazy.Text Ply #-}
+{-# SPECIALISE relaxedSAN :: Position -> Parser String Ply #-}
+{-# SPECIALISE strictSAN :: Position -> Parser Strict.ByteString Ply #-}
+{-# SPECIALISE strictSAN :: Position -> Parser Lazy.ByteString Ply #-}
+{-# SPECIALISE strictSAN :: Position -> Parser Strict.Text Ply #-}
+{-# SPECIALISE strictSAN :: Position -> Parser Lazy.Text Ply #-}
+{-# SPECIALISE strictSAN :: Position -> Parser String Ply #-}
diff --git a/src/Game/Chess/PGN.hs b/src/Game/Chess/PGN.hs
new file mode 100644
--- /dev/null
+++ b/src/Game/Chess/PGN.hs
@@ -0,0 +1,204 @@
+{-# LANGUAGE GADTs #-}
+module Game.Chess.PGN (
+  readPGNFile, gameFromForest, PGN(..), Game, Outcome(..)
+, hPutPGN, pgnDoc, RAVOrder, breadthFirst, depthFirst, gameDoc) where
+
+import Control.Monad
+import Data.Bifunctor
+import Data.ByteString.Char8 (ByteString)
+import qualified Data.ByteString.Char8 as BS
+import Data.Char
+import Data.Foldable
+import Data.Functor
+import Data.Maybe
+import Data.Text (Text)
+import qualified Data.Text as T
+import qualified Data.Text.Encoding as T
+import Data.Text.Prettyprint.Doc hiding (space)
+import Data.Text.Prettyprint.Doc.Render.Text
+import Data.Tree
+import Data.Word
+import Data.Void
+import Game.Chess
+import System.IO
+import Text.Megaparsec
+import Text.Megaparsec.Byte
+import qualified Text.Megaparsec.Byte.Lexer as L
+
+gameFromForest :: [(ByteString, Text)] -> Forest Ply -> Outcome -> Game
+gameFromForest tags forest o = (("Result", r):tags, (o, (fmap . fmap) f forest)) where
+  f pl = PlyData [] pl []
+  r = case o of
+    Win White -> "1-0"
+    Win Black -> "0-1"
+    Draw      -> "1/2-1/2"
+    Undecided -> "*"
+
+newtype PGN = PGN [Game] deriving (Eq, Monoid, Semigroup)
+type Game = ([(ByteString, Text)], (Outcome, Forest PlyData))
+data Outcome = Win Color
+             | Draw
+             | Undecided
+             deriving (Eq, Show)
+
+instance Pretty Outcome where
+  pretty (Win White) = "1-0"
+  pretty (Win Black) = "0-1"
+  pretty Draw        = "1/2-1/2"
+  pretty Undecided   = "*"
+
+data PlyData = PlyData {
+  prefixNAG :: ![Int]
+, ply :: !Ply
+, suffixNAG :: ![Int]
+} deriving (Eq, Show)
+
+readPGNFile :: FilePath -> IO (Either String PGN)
+readPGNFile fp = first errorBundlePretty . parse pgn fp <$> BS.readFile fp
+
+hPutPGN :: Handle -> RAVOrder (Doc ann) -> PGN -> IO ()
+hPutPGN h ro (PGN games) = for_ games $ \game -> do
+  hPutDoc h $ gameDoc ro game
+  hPutStrLn h ""
+
+type Parser = Parsec Void ByteString
+
+spaceConsumer :: Parser ()
+spaceConsumer = L.space
+  space1 (L.skipLineComment ";") (L.skipBlockComment "{" "}")
+
+lexeme :: Parser a -> Parser a
+lexeme = L.lexeme spaceConsumer
+
+eog :: Parser Outcome
+eog = lexeme $  string "1-0" $> Win White
+            <|> string "0-1" $> Win Black
+            <|> string "1/2-1/2" $> Draw
+            <|> string "*" $> Undecided
+
+sym :: Parser ByteString
+sym = lexeme . fmap fst . match $ do
+  void $ alphaNumChar
+  many $ alphaNumChar <|> oneOf [35,43,45,58,61,95]
+
+lbraceChar, rbraceChar, semiChar, periodChar, quoteChar, backslashChar, dollarChar :: Word8
+lbraceChar    = fromIntegral $ ord '{'
+rbraceChar    = fromIntegral $ ord '}'
+semiChar      = fromIntegral $ ord ';'
+periodChar    = fromIntegral $ ord '.'
+quoteChar     = fromIntegral $ ord '"'
+backslashChar = fromIntegral $ ord '\\'
+dollarChar    = fromIntegral $ ord '$'
+
+lbracketP, rbracketP, lparenP, rparenP :: Parser ()
+lbracketP = void . lexeme . single . fromIntegral $ ord '['
+rbracketP = void . lexeme . single . fromIntegral $ ord ']'
+lparenP   = void . lexeme . single . fromIntegral $ ord '('
+rparenP   = void . lexeme . single . fromIntegral $ ord ')'
+
+nag :: Parser Int
+nag = lexeme $  single dollarChar *> L.decimal
+            <|> string "!!" $> 3
+            <|> string "??" $> 4
+            <|> string "!?" $> 5
+            <|> string "?!" $> 6
+            <|> string "!"  $> 1
+            <|> string "?"  $> 2
+
+comment :: Parser String
+comment = (fmap . fmap) (chr . fromEnum) $
+      single semiChar *> manyTill anySingle (eof <|> void eol)
+  <|> single lbraceChar *> many (anySingleBut rbraceChar) <* single rbraceChar
+
+tagPair :: Parser (ByteString, Text)
+tagPair = lexeme $ do
+  lbracketP
+  k <- sym
+  v <- str
+  rbracketP
+  pure $ (k, v)
+
+tagList :: Parser [(ByteString, Text)]
+tagList = many tagPair
+
+movetext :: Position -> Parser (Outcome, Forest PlyData)
+movetext pos = (,[]) <$> eog <|> main pos where
+  main p = ply p >>= \(m, n) -> fmap n <$> movetext (unsafeDoPly p m)
+  var p = ply p >>= \(m, n) -> n <$> (rparenP $> [] <|> var (unsafeDoPly p m))
+  ply p = do
+    pnags <- many nag
+    validateMoveNumber p
+    m <- lexeme $ relaxedSAN p
+    snags <- many nag
+    rav <- concat <$> many (lparenP *> var p)
+    pure $ (m, \xs -> Node (PlyData pnags m snags) xs:rav)
+  validateMoveNumber p =
+    optional (lexeme $ L.decimal <* space <* many (single periodChar)) >>= \case
+      Just n | moveNumber p /= n ->
+        fail $ "Invalid move number: " <> show n <> " /= " <> show (moveNumber p)
+      _ -> pure ()
+
+pgn :: Parser PGN
+pgn = spaceConsumer *> fmap PGN (many game) <* spaceConsumer <* eof
+
+game :: Parser Game
+game = do
+  tl <- tagList
+  pos <- case lookup "FEN" tl of
+    Nothing -> pure startpos
+    Just fen -> case fromFEN (T.unpack fen) of
+      Just p -> pure p
+      Nothing -> fail "Invalid FEN"
+  (tl,) <$> movetext pos
+  
+str :: Parser Text
+str = p <?> "string" where
+  p = fmap (T.pack . fmap (chr . fromEnum)) $ single quoteChar *> many ch <* single quoteChar
+  ch = single backslashChar *> (  single backslashChar $> backslashChar
+                          <|> single quoteChar $> quoteChar
+                           )
+   <|> anySingleBut quoteChar
+
+type RAVOrder a = (Forest PlyData -> a) -> Forest PlyData -> [a]
+
+breadthFirst, depthFirst :: RAVOrder a
+breadthFirst _ [] = []
+breadthFirst f ts = pure $ f ts
+depthFirst f = fmap $ f . pure
+
+pgnDoc :: RAVOrder (Doc ann) -> PGN -> Doc ann
+pgnDoc ro (PGN games) = vsep $ gameDoc ro <$> games
+
+gameDoc :: RAVOrder (Doc ann) -> Game -> Doc ann
+gameDoc ro (tl, mt)
+  | null tl = moveDoc ro pos mt
+  | otherwise = tagsDoc tl <> line <> line <> moveDoc ro pos mt
+ where
+  pos | Just fen <- lookup "FEN" tl = fromJust $ fromFEN (T.unpack fen)
+      | otherwise = startpos
+
+tagsDoc :: [(ByteString, Text)] -> Doc ann
+tagsDoc = vsep . fmap tagpair where
+  tagpair (k, esc -> v) = brackets $ pretty (BS.unpack k) <+> dquotes (pretty v)
+  esc = T.concatMap e where
+    e '\\' = T.pack "\\\\"
+    e '"' = T.pack "\\\""
+    e c = T.singleton c
+
+moveDoc :: RAVOrder (Doc ann) -> Position -> (Outcome, Forest PlyData) -> Doc ann
+moveDoc ro pos (o,ts) = (fillSep $ go pos True ts <> [pretty o]) <> line where
+  go _ _ [] = []
+  go pos pmn (t:ts)
+    | color pos == White || pmn
+    = pnag <> (mn:san:snag) <> rav <> go pos' (not . null $ rav) (subForest t)
+    | otherwise
+    = pnag <> (san:snag) <> rav <> go pos' (not . null $ rav) (subForest t)
+   where
+    pl = ply . rootLabel $ t
+    san = pretty $ unsafeToSAN pos pl
+    pos' = unsafeDoPly pos pl
+    pnag = nag <$> prefixNAG (rootLabel t)
+    mn = pretty (moveNumber pos) <> if color pos == White then "." else "..."
+    rav = ro (parens . fillSep . go pos True) ts
+    snag = nag <$> suffixNAG (rootLabel t)
+  nag n = "$" <> pretty n
diff --git a/src/Game/Chess/Polyglot/Book.hs b/src/Game/Chess/Polyglot/Book.hs
new file mode 100644
--- /dev/null
+++ b/src/Game/Chess/Polyglot/Book.hs
@@ -0,0 +1,114 @@
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TemplateHaskell #-}
+module Game.Chess.Polyglot.Book (
+  PolyglotBook
+, fromByteString
+, defaultBook, twic
+, readPolyglotFile
+, bookPly
+, bookPlies
+, bookForest
+) where
+
+import Control.Arrow
+import Control.Monad.Random (Rand)
+import qualified Control.Monad.Random as Rand
+import Data.Bits
+import Data.ByteString (ByteString)
+import qualified Data.ByteString.Internal as BS
+import qualified Data.ByteString as BS
+import Data.FileEmbed
+import qualified Data.Vector.Storable as VS
+import Data.Tree
+import Data.Word
+import Foreign.ForeignPtr (plusForeignPtr)
+import Foreign.Ptr (castPtr)
+import Foreign.Storable
+import Game.Chess
+import Game.Chess.Polyglot.Hash
+import GHC.Ptr
+import System.Random (RandomGen)
+
+data BookEntry = BookEntry {
+  key :: {-# UNPACK #-} !Word64
+, ply :: {-# UNPACK #-} !Ply
+, weight :: {-# UNPACK #-} !Word16
+, learn :: {-# UNPACK #-} !Word32
+} deriving (Eq, Show)
+
+instance Storable BookEntry where
+  sizeOf _ = 16
+  alignment _ = alignment (undefined :: Word64)
+  peek ptr = BookEntry <$> peekBE (castPtr ptr)
+                       <*> (Ply <$> peekBE (castPtr ptr `plusPtr` 8))
+                       <*> peekBE (castPtr ptr `plusPtr` 10)
+                       <*> peekBE (castPtr ptr `plusPtr` 12)
+  poke ptr (BookEntry key (Ply ply) weight learn) = do
+    pokeBE (castPtr ptr) key
+    pokeBE (castPtr ptr `plusPtr` 8) ply
+    pokeBE (castPtr ptr `plusPtr` 10) weight
+    pokeBE (castPtr ptr `plusPtr` 12) learn
+
+peekBE :: forall a. (Bits a, Num a, Storable a) => Ptr Word8 -> IO a
+peekBE ptr = go ptr 0 (sizeOf (undefined :: a)) where
+  go _ !x 0 = pure x
+  go !p !x !n = peek p >>= \w8 -> 
+    go (p `plusPtr` 1) (x `shiftL` 8 .|. fromIntegral w8) (n - 1)
+
+pokeBE :: forall a. (Bits a, Integral a, Num a, Storable a) => Ptr Word8 -> a -> IO ()
+pokeBE p x = go x (sizeOf x) where
+  go _ 0 = pure ()
+  go !x !n = do
+    pokeElemOff p (n-1) (fromIntegral x)
+    go (x `shiftR` 8) (n-1)
+
+defaultBook, twic :: PolyglotBook
+defaultBook = twic
+twic = fromByteString $(embedFile "book/twic-9g.bin")
+
+pv :: PolyglotBook -> [Ply]
+pv b = head . concatMap paths $ bookForest b startpos
+
+newtype PolyglotBook = Book (VS.Vector BookEntry)
+
+fromByteString :: ByteString -> PolyglotBook
+fromByteString bs = Book v where
+  v = VS.unsafeFromForeignPtr0 (plusForeignPtr fptr off) (len `div` elemSize)
+  (fptr, off, len) = BS.toForeignPtr bs
+  elemSize = sizeOf (undefined `asTypeOf` VS.head v)
+
+readPolyglotFile :: FilePath -> IO PolyglotBook
+readPolyglotFile = fmap fromByteString . BS.readFile
+
+bookForest :: PolyglotBook -> Position -> Forest Ply
+bookForest b p = tree <$> bookPlies b p where
+  tree pl = Node pl . bookForest b $ unsafeDoPly p pl
+
+paths :: Tree a -> [[a]]
+paths = foldTree f where
+  f a [] = [[a]]
+  f a xs = (a :) <$> concat xs
+
+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
+
+bookPlies :: PolyglotBook -> Position -> [Ply]
+bookPlies b pos
+  | halfMoveClock pos > 150 = []
+  | otherwise = ply <$> findPosition b pos
+
+findPosition :: PolyglotBook -> Position -> [BookEntry]
+findPosition (Book v) pos = fmap conv . VS.toList .
+  VS.takeWhile ((hash ==) . key) . VS.unsafeDrop (lowerBound hash) $ v
+ where
+  conv be@BookEntry{ply} = be { ply = fromPolyglot pos ply }
+  hash = hashPosition pos
+  lowerBound = bsearch (key . VS.unsafeIndex v) (0, VS.length v - 1)
+  bsearch :: (Integral a, Ord b) => (a -> b) -> (a, a) -> b -> a
+  bsearch f (lo, hi) x
+    | lo >= hi   = lo
+    | x <= f mid = bsearch f (lo, mid) x
+    | otherwise  = bsearch f (mid + 1, hi) x
+   where mid = (lo + hi) `div` 2
diff --git a/src/Game/Chess/Polyglot/Hash.hs b/src/Game/Chess/Polyglot/Hash.hs
new file mode 100644
--- /dev/null
+++ b/src/Game/Chess/Polyglot/Hash.hs
@@ -0,0 +1,234 @@
+module Game.Chess.Polyglot.Hash (hashPosition, pieceKey, castleKey, turnKey) where
+
+import Data.Bits
+import Data.Maybe
+import qualified Data.Vector.Unboxed as Unboxed
+import Data.Ix
+import Data.Word
+import Game.Chess
+
+hashPosition :: Position -> Word64
+hashPosition pos = piece `xor` castling `xor` ep `xor` turn where
+  piece = foldr xor 0 $ mapMaybe f [A1 .. ] where
+    f sq = (\(c, p) -> pieceKey (p, c, sq)) <$> pieceAt pos sq
+  castling = foldr (xor . castleKey) 0 $ castlingRights pos
+  ep = 0 -- TODO
+  turn = case color pos of
+    White -> turnKey
+    Black -> 0
+
+pieceKey :: (PieceType, Color, Sq) -> Word64
+pieceKey = Unboxed.unsafeIndex pieceKeys . index ((Pawn,Black,A1),(King,White,H8))
+
+castleKey :: (Color, Castle) -> Word64
+castleKey (c, s) = Unboxed.unsafeIndex castleKeys $
+  index ((Black, Kingside), (White, Queenside)) (opponent c, s)
+
+pieceKeys, castleKeys, epKeys :: Unboxed.Vector Word64
+pieceKeys = Unboxed.fromList
+  [0x9D39247E33776D41,0x2AF7398005AAA5C7,0x44DB015024623547,0x9C15F73E62A76AE2
+  ,0x75834465489C0C89,0x3290AC3A203001BF,0x0FBBAD1F61042279,0xE83A908FF2FB60CA
+  ,0x0D7E765D58755C10,0x1A083822CEAFE02D,0x9605D5F0E25EC3B0,0xD021FF5CD13A2ED5
+  ,0x40BDF15D4A672E32,0x011355146FD56395,0x5DB4832046F3D9E5,0x239F8B2D7FF719CC
+  ,0x05D1A1AE85B49AA1,0x679F848F6E8FC971,0x7449BBFF801FED0B,0x7D11CDB1C3B7ADF0
+  ,0x82C7709E781EB7CC,0xF3218F1C9510786C,0x331478F3AF51BBE6,0x4BB38DE5E7219443
+  ,0xAA649C6EBCFD50FC,0x8DBD98A352AFD40B,0x87D2074B81D79217,0x19F3C751D3E92AE1
+  ,0xB4AB30F062B19ABF,0x7B0500AC42047AC4,0xC9452CA81A09D85D,0x24AA6C514DA27500
+  ,0x4C9F34427501B447,0x14A68FD73C910841,0xA71B9B83461CBD93,0x03488B95B0F1850F
+  ,0x637B2B34FF93C040,0x09D1BC9A3DD90A94,0x3575668334A1DD3B,0x735E2B97A4C45A23
+  ,0x18727070F1BD400B,0x1FCBACD259BF02E7,0xD310A7C2CE9B6555,0xBF983FE0FE5D8244
+  ,0x9F74D14F7454A824,0x51EBDC4AB9BA3035,0x5C82C505DB9AB0FA,0xFCF7FE8A3430B241
+  ,0x3253A729B9BA3DDE,0x8C74C368081B3075,0xB9BC6C87167C33E7,0x7EF48F2B83024E20
+  ,0x11D505D4C351BD7F,0x6568FCA92C76A243,0x4DE0B0F40F32A7B8,0x96D693460CC37E5D
+  ,0x42E240CB63689F2F,0x6D2BDCDAE2919661,0x42880B0236E4D951,0x5F0F4A5898171BB6
+  ,0x39F890F579F92F88,0x93C5B5F47356388B,0x63DC359D8D231B78,0xEC16CA8AEA98AD76
+  ,0x5355F900C2A82DC7,0x07FB9F855A997142,0x5093417AA8A7ED5E,0x7BCBC38DA25A7F3C
+  ,0x19FC8A768CF4B6D4,0x637A7780DECFC0D9,0x8249A47AEE0E41F7,0x79AD695501E7D1E8
+  ,0x14ACBAF4777D5776,0xF145B6BECCDEA195,0xDABF2AC8201752FC,0x24C3C94DF9C8D3F6
+  ,0xBB6E2924F03912EA,0x0CE26C0B95C980D9,0xA49CD132BFBF7CC4,0xE99D662AF4243939
+  ,0x27E6AD7891165C3F,0x8535F040B9744FF1,0x54B3F4FA5F40D873,0x72B12C32127FED2B
+  ,0xEE954D3C7B411F47,0x9A85AC909A24EAA1,0x70AC4CD9F04F21F5,0xF9B89D3E99A075C2
+  ,0x87B3E2B2B5C907B1,0xA366E5B8C54F48B8,0xAE4A9346CC3F7CF2,0x1920C04D47267BBD
+  ,0x87BF02C6B49E2AE9,0x092237AC237F3859,0xFF07F64EF8ED14D0,0x8DE8DCA9F03CC54E
+  ,0x9C1633264DB49C89,0xB3F22C3D0B0B38ED,0x390E5FB44D01144B,0x5BFEA5B4712768E9
+  ,0x1E1032911FA78984,0x9A74ACB964E78CB3,0x4F80F7A035DAFB04,0x6304D09A0B3738C4
+  ,0x2171E64683023A08,0x5B9B63EB9CEFF80C,0x506AACF489889342,0x1881AFC9A3A701D6
+  ,0x6503080440750644,0xDFD395339CDBF4A7,0xEF927DBCF00C20F2,0x7B32F7D1E03680EC
+  ,0xB9FD7620E7316243,0x05A7E8A57DB91B77,0xB5889C6E15630A75,0x4A750A09CE9573F7
+  ,0xCF464CEC899A2F8A,0xF538639CE705B824,0x3C79A0FF5580EF7F,0xEDE6C87F8477609D
+  ,0x799E81F05BC93F31,0x86536B8CF3428A8C,0x97D7374C60087B73,0xA246637CFF328532
+  ,0x043FCAE60CC0EBA0,0x920E449535DD359E,0x70EB093B15B290CC,0x73A1921916591CBD
+  ,0x56436C9FE1A1AA8D,0xEFAC4B70633B8F81,0xBB215798D45DF7AF,0x45F20042F24F1768
+  ,0x930F80F4E8EB7462,0xFF6712FFCFD75EA1,0xAE623FD67468AA70,0xDD2C5BC84BC8D8FC
+  ,0x7EED120D54CF2DD9,0x22FE545401165F1C,0xC91800E98FB99929,0x808BD68E6AC10365
+  ,0xDEC468145B7605F6,0x1BEDE3A3AEF53302,0x43539603D6C55602,0xAA969B5C691CCB7A
+  ,0xA87832D392EFEE56,0x65942C7B3C7E11AE,0xDED2D633CAD004F6,0x21F08570F420E565
+  ,0xB415938D7DA94E3C,0x91B859E59ECB6350,0x10CFF333E0ED804A,0x28AED140BE0BB7DD
+  ,0xC5CC1D89724FA456,0x5648F680F11A2741,0x2D255069F0B7DAB3,0x9BC5A38EF729ABD4
+  ,0xEF2F054308F6A2BC,0xAF2042F5CC5C2858,0x480412BAB7F5BE2A,0xAEF3AF4A563DFE43
+  ,0x19AFE59AE451497F,0x52593803DFF1E840,0xF4F076E65F2CE6F0,0x11379625747D5AF3
+  ,0xBCE5D2248682C115,0x9DA4243DE836994F,0x066F70B33FE09017,0x4DC4DE189B671A1C
+  ,0x51039AB7712457C3,0xC07A3F80C31FB4B4,0xB46EE9C5E64A6E7C,0xB3819A42ABE61C87
+  ,0x21A007933A522A20,0x2DF16F761598AA4F,0x763C4A1371B368FD,0xF793C46702E086A0
+  ,0xD7288E012AEB8D31,0xDE336A2A4BC1C44B,0x0BF692B38D079F23,0x2C604A7A177326B3
+  ,0x4850E73E03EB6064,0xCFC447F1E53C8E1B,0xB05CA3F564268D99,0x9AE182C8BC9474E8
+  ,0xA4FC4BD4FC5558CA,0xE755178D58FC4E76,0x69B97DB1A4C03DFE,0xF9B5B7C4ACC67C96
+  ,0xFC6A82D64B8655FB,0x9C684CB6C4D24417,0x8EC97D2917456ED0,0x6703DF9D2924E97E
+  ,0xC547F57E42A7444E,0x78E37644E7CAD29E,0xFE9A44E9362F05FA,0x08BD35CC38336615,
+   0x9315E5EB3A129ACE, 0x94061B871E04DF75, 0xDF1D9F9D784BA010, 0x3BBA57B68871B59D,
+   0xD2B7ADEEDED1F73F, 0xF7A255D83BC373F8, 0xD7F4F2448C0CEB81, 0xD95BE88CD210FFA7,
+   0x336F52F8FF4728E7, 0xA74049DAC312AC71, 0xA2F61BB6E437FDB5, 0x4F2A5CB07F6A35B3,
+   0x87D380BDA5BF7859, 0x16B9F7E06C453A21, 0x7BA2484C8A0FD54E, 0xF3A678CAD9A2E38C,
+   0x39B0BF7DDE437BA2, 0xFCAF55C1BF8A4424, 0x18FCF680573FA594, 0x4C0563B89F495AC3,
+   0x40E087931A00930D, 0x8CFFA9412EB642C1, 0x68CA39053261169F, 0x7A1EE967D27579E2,
+   0x9D1D60E5076F5B6F, 0x3810E399B6F65BA2, 0x32095B6D4AB5F9B1, 0x35CAB62109DD038A,
+   0xA90B24499FCFAFB1, 0x77A225A07CC2C6BD, 0x513E5E634C70E331, 0x4361C0CA3F692F12,
+   0xD941ACA44B20A45B, 0x528F7C8602C5807B, 0x52AB92BEB9613989, 0x9D1DFA2EFC557F73,
+   0x722FF175F572C348, 0x1D1260A51107FE97, 0x7A249A57EC0C9BA2, 0x04208FE9E8F7F2D6,
+   0x5A110C6058B920A0, 0x0CD9A497658A5698, 0x56FD23C8F9715A4C, 0x284C847B9D887AAE,
+   0x04FEABFBBDB619CB, 0x742E1E651C60BA83, 0x9A9632E65904AD3C, 0x881B82A13B51B9E2,
+   0x506E6744CD974924, 0xB0183DB56FFC6A79, 0x0ED9B915C66ED37E, 0x5E11E86D5873D484,
+   0xF678647E3519AC6E, 0x1B85D488D0F20CC5, 0xDAB9FE6525D89021, 0x0D151D86ADB73615,
+   0xA865A54EDCC0F019, 0x93C42566AEF98FFB, 0x99E7AFEABE000731, 0x48CBFF086DDF285A,
+   0x7F9B6AF1EBF78BAF, 0x58627E1A149BBA21, 0x2CD16E2ABD791E33, 0xD363EFF5F0977996,
+   0x0CE2A38C344A6EED, 0x1A804AADB9CFA741, 0x907F30421D78C5DE, 0x501F65EDB3034D07,
+   0x37624AE5A48FA6E9, 0x957BAF61700CFF4E, 0x3A6C27934E31188A, 0xD49503536ABCA345,
+   0x088E049589C432E0, 0xF943AEE7FEBF21B8, 0x6C3B8E3E336139D3, 0x364F6FFA464EE52E,
+   0xD60F6DCEDC314222, 0x56963B0DCA418FC0, 0x16F50EDF91E513AF, 0xEF1955914B609F93,
+   0x565601C0364E3228, 0xECB53939887E8175, 0xBAC7A9A18531294B, 0xB344C470397BBA52,
+   0x65D34954DAF3CEBD, 0xB4B81B3FA97511E2, 0xB422061193D6F6A7, 0x071582401C38434D,
+   0x7A13F18BBEDC4FF5, 0xBC4097B116C524D2, 0x59B97885E2F2EA28, 0x99170A5DC3115544,
+   0x6F423357E7C6A9F9, 0x325928EE6E6F8794, 0xD0E4366228B03343, 0x565C31F7DE89EA27,
+   0x30F5611484119414, 0xD873DB391292ED4F, 0x7BD94E1D8E17DEBC, 0xC7D9F16864A76E94,
+   0x947AE053EE56E63C, 0xC8C93882F9475F5F, 0x3A9BF55BA91F81CA, 0xD9A11FBB3D9808E4,
+   0x0FD22063EDC29FCA, 0xB3F256D8ACA0B0B9, 0xB03031A8B4516E84, 0x35DD37D5871448AF,
+   0xE9F6082B05542E4E, 0xEBFAFA33D7254B59, 0x9255ABB50D532280, 0xB9AB4CE57F2D34F3,
+   0x693501D628297551, 0xC62C58F97DD949BF, 0xCD454F8F19C5126A, 0xBBE83F4ECC2BDECB,
+   0xDC842B7E2819E230, 0xBA89142E007503B8, 0xA3BC941D0A5061CB, 0xE9F6760E32CD8021,
+   0x09C7E552BC76492F, 0x852F54934DA55CC9, 0x8107FCCF064FCF56, 0x098954D51FFF6580,
+   0x23B70EDB1955C4BF, 0xC330DE426430F69D, 0x4715ED43E8A45C0A, 0xA8D7E4DAB780A08D,
+   0x0572B974F03CE0BB, 0xB57D2E985E1419C7, 0xE8D9ECBE2CF3D73F, 0x2FE4B17170E59750,
+   0x11317BA87905E790, 0x7FBF21EC8A1F45EC, 0x1725CABFCB045B00, 0x964E915CD5E2B207,
+   0x3E2B8BCBF016D66D, 0xBE7444E39328A0AC, 0xF85B2B4FBCDE44B7, 0x49353FEA39BA63B1,
+   0x1DD01AAFCD53486A, 0x1FCA8A92FD719F85, 0xFC7C95D827357AFA, 0x18A6A990C8B35EBD,
+   0xCCCB7005C6B9C28D, 0x3BDBB92C43B17F26, 0xAA70B5B4F89695A2, 0xE94C39A54A98307F,
+   0xB7A0B174CFF6F36E, 0xD4DBA84729AF48AD, 0x2E18BC1AD9704A68, 0x2DE0966DAF2F8B1C,
+   0xB9C11D5B1E43A07E, 0x64972D68DEE33360, 0x94628D38D0C20584, 0xDBC0D2B6AB90A559,
+   0xD2733C4335C6A72F, 0x7E75D99D94A70F4D, 0x6CED1983376FA72B, 0x97FCAACBF030BC24,
+   0x7B77497B32503B12, 0x8547EDDFB81CCB94, 0x79999CDFF70902CB, 0xCFFE1939438E9B24,
+   0x829626E3892D95D7, 0x92FAE24291F2B3F1, 0x63E22C147B9C3403, 0xC678B6D860284A1C,
+   0x5873888850659AE7, 0x0981DCD296A8736D, 0x9F65789A6509A440, 0x9FF38FED72E9052F,
+   0xE479EE5B9930578C, 0xE7F28ECD2D49EECD, 0x56C074A581EA17FE, 0x5544F7D774B14AEF,
+   0x7B3F0195FC6F290F, 0x12153635B2C0CF57, 0x7F5126DBBA5E0CA7, 0x7A76956C3EAFB413,
+   0x3D5774A11D31AB39, 0x8A1B083821F40CB4, 0x7B4A38E32537DF62, 0x950113646D1D6E03,
+   0x4DA8979A0041E8A9, 0x3BC36E078F7515D7, 0x5D0A12F27AD310D1, 0x7F9D1A2E1EBE1327,
+   0xDA3A361B1C5157B1, 0xDCDD7D20903D0C25, 0x36833336D068F707, 0xCE68341F79893389,
+   0xAB9090168DD05F34, 0x43954B3252DC25E5, 0xB438C2B67F98E5E9, 0x10DCD78E3851A492,
+   0xDBC27AB5447822BF, 0x9B3CDB65F82CA382, 0xB67B7896167B4C84, 0xBFCED1B0048EAC50,
+   0xA9119B60369FFEBD, 0x1FFF7AC80904BF45, 0xAC12FB171817EEE7, 0xAF08DA9177DDA93D,
+   0x1B0CAB936E65C744, 0xB559EB1D04E5E932, 0xC37B45B3F8D6F2BA, 0xC3A9DC228CAAC9E9,
+   0xF3B8B6675A6507FF, 0x9FC477DE4ED681DA, 0x67378D8ECCEF96CB, 0x6DD856D94D259236,
+   0xA319CE15B0B4DB31, 0x073973751F12DD5E, 0x8A8E849EB32781A5, 0xE1925C71285279F5,
+   0x74C04BF1790C0EFE, 0x4DDA48153C94938A, 0x9D266D6A1CC0542C, 0x7440FB816508C4FE,
+   0x13328503DF48229F, 0xD6BF7BAEE43CAC40, 0x4838D65F6EF6748F, 0x1E152328F3318DEA,
+   0x8F8419A348F296BF, 0x72C8834A5957B511, 0xD7A023A73260B45C, 0x94EBC8ABCFB56DAE,
+   0x9FC10D0F989993E0, 0xDE68A2355B93CAE6, 0xA44CFE79AE538BBE, 0x9D1D84FCCE371425,
+   0x51D2B1AB2DDFB636, 0x2FD7E4B9E72CD38C, 0x65CA5B96B7552210, 0xDD69A0D8AB3B546D,
+   0x604D51B25FBF70E2, 0x73AA8A564FB7AC9E, 0x1A8C1E992B941148, 0xAAC40A2703D9BEA0,
+   0x764DBEAE7FA4F3A6, 0x1E99B96E70A9BE8B, 0x2C5E9DEB57EF4743, 0x3A938FEE32D29981,
+   0x26E6DB8FFDF5ADFE, 0x469356C504EC9F9D, 0xC8763C5B08D1908C, 0x3F6C6AF859D80055,
+   0x7F7CC39420A3A545, 0x9BFB227EBDF4C5CE, 0x89039D79D6FC5C5C, 0x8FE88B57305E2AB6,
+   0xA09E8C8C35AB96DE, 0xFA7E393983325753, 0xD6B6D0ECC617C699, 0xDFEA21EA9E7557E3,
+   0xB67C1FA481680AF8, 0xCA1E3785A9E724E5, 0x1CFC8BED0D681639, 0xD18D8549D140CAEA,
+   0x4ED0FE7E9DC91335, 0xE4DBF0634473F5D2, 0x1761F93A44D5AEFE, 0x53898E4C3910DA55,
+   0x734DE8181F6EC39A, 0x2680B122BAA28D97, 0x298AF231C85BAFAB, 0x7983EED3740847D5,
+   0x66C1A2A1A60CD889, 0x9E17E49642A3E4C1, 0xEDB454E7BADC0805, 0x50B704CAB602C329,
+   0x4CC317FB9CDDD023, 0x66B4835D9EAFEA22, 0x219B97E26FFC81BD, 0x261E4E4C0A333A9D,
+   0x1FE2CCA76517DB90, 0xD7504DFA8816EDBB, 0xB9571FA04DC089C8, 0x1DDC0325259B27DE,
+   0xCF3F4688801EB9AA, 0xF4F5D05C10CAB243, 0x38B6525C21A42B0E, 0x36F60E2BA4FA6800,
+   0xEB3593803173E0CE, 0x9C4CD6257C5A3603, 0xAF0C317D32ADAA8A, 0x258E5A80C7204C4B,
+   0x8B889D624D44885D, 0xF4D14597E660F855, 0xD4347F66EC8941C3, 0xE699ED85B0DFB40D,
+   0x2472F6207C2D0484, 0xC2A1E7B5B459AEB5, 0xAB4F6451CC1D45EC, 0x63767572AE3D6174,
+   0xA59E0BD101731A28, 0x116D0016CB948F09, 0x2CF9C8CA052F6E9F, 0x0B090A7560A968E3,
+   0xABEEDDB2DDE06FF1, 0x58EFC10B06A2068D, 0xC6E57A78FBD986E0, 0x2EAB8CA63CE802D7,
+   0x14A195640116F336, 0x7C0828DD624EC390, 0xD74BBE77E6116AC7, 0x804456AF10F5FB53,
+   0xEBE9EA2ADF4321C7, 0x03219A39EE587A30, 0x49787FEF17AF9924, 0xA1E9300CD8520548,
+   0x5B45E522E4B1B4EF, 0xB49C3B3995091A36, 0xD4490AD526F14431, 0x12A8F216AF9418C2,
+   0x001F837CC7350524, 0x1877B51E57A764D5, 0xA2853B80F17F58EE, 0x993E1DE72D36D310,
+   0xB3598080CE64A656, 0x252F59CF0D9F04BB, 0xD23C8E176D113600, 0x1BDA0492E7E4586E,
+   0x21E0BD5026C619BF, 0x3B097ADAF088F94E, 0x8D14DEDB30BE846E, 0xF95CFFA23AF5F6F4,
+   0x3871700761B3F743, 0xCA672B91E9E4FA16, 0x64C8E531BFF53B55, 0x241260ED4AD1E87D,
+   0x106C09B972D2E822, 0x7FBA195410E5CA30, 0x7884D9BC6CB569D8, 0x0647DFEDCD894A29,
+   0x63573FF03E224774, 0x4FC8E9560F91B123, 0x1DB956E450275779, 0xB8D91274B9E9D4FB,
+   0xA2EBEE47E2FBFCE1, 0xD9F1F30CCD97FB09, 0xEFED53D75FD64E6B, 0x2E6D02C36017F67F,
+   0xA9AA4D20DB084E9B, 0xB64BE8D8B25396C1, 0x70CB6AF7C2D5BCF0, 0x98F076A4F7A2322E,
+   0xBF84470805E69B5F, 0x94C3251F06F90CF3, 0x3E003E616A6591E9, 0xB925A6CD0421AFF3,
+   0x61BDD1307C66E300, 0xBF8D5108E27E0D48, 0x240AB57A8B888B20, 0xFC87614BAF287E07,
+   0xEF02CDD06FFDB432, 0xA1082C0466DF6C0A, 0x8215E577001332C8, 0xD39BB9C3A48DB6CF,
+   0x2738259634305C14, 0x61CF4F94C97DF93D, 0x1B6BACA2AE4E125B, 0x758F450C88572E0B,
+   0x959F587D507A8359, 0xB063E962E045F54D, 0x60E8ED72C0DFF5D1, 0x7B64978555326F9F,
+   0xFD080D236DA814BA, 0x8C90FD9B083F4558, 0x106F72FE81E2C590, 0x7976033A39F7D952,
+   0xA4EC0132764CA04B, 0x733EA705FAE4FA77, 0xB4D8F77BC3E56167, 0x9E21F4F903B33FD9,
+   0x9D765E419FB69F6D, 0xD30C088BA61EA5EF, 0x5D94337FBFAF7F5B, 0x1A4E4822EB4D7A59,
+   0x6FFE73E81B637FB3, 0xDDF957BC36D8B9CA, 0x64D0E29EEA8838B3, 0x08DD9BDFD96B9F63,
+   0x087E79E5A57D1D13, 0xE328E230E3E2B3FB, 0x1C2559E30F0946BE, 0x720BF5F26F4D2EAA,
+   0xB0774D261CC609DB, 0x443F64EC5A371195, 0x4112CF68649A260E, 0xD813F2FAB7F5C5CA,
+   0x660D3257380841EE, 0x59AC2C7873F910A3, 0xE846963877671A17, 0x93B633ABFA3469F8,
+   0xC0C0F5A60EF4CDCF, 0xCAF21ECD4377B28C, 0x57277707199B8175, 0x506C11B9D90E8B1D,
+   0xD83CC2687A19255F, 0x4A29C6465A314CD1, 0xED2DF21216235097, 0xB5635C95FF7296E2,
+   0x22AF003AB672E811, 0x52E762596BF68235, 0x9AEBA33AC6ECC6B0, 0x944F6DE09134DFB6,
+   0x6C47BEC883A7DE39, 0x6AD047C430A12104, 0xA5B1CFDBA0AB4067, 0x7C45D833AFF07862,
+   0x5092EF950A16DA0B, 0x9338E69C052B8E7B, 0x455A4B4CFE30E3F5, 0x6B02E63195AD0CF8,
+   0x6B17B224BAD6BF27, 0xD1E0CCD25BB9C169, 0xDE0C89A556B9AE70, 0x50065E535A213CF6,
+   0x9C1169FA2777B874, 0x78EDEFD694AF1EED, 0x6DC93D9526A50E68, 0xEE97F453F06791ED,
+   0x32AB0EDB696703D3, 0x3A6853C7E70757A7, 0x31865CED6120F37D, 0x67FEF95D92607890,
+   0x1F2B1D1F15F6DC9C, 0xB69E38A8965C6B65, 0xAA9119FF184CCCF4, 0xF43C732873F24C13,
+   0xFB4A3D794A9A80D2, 0x3550C2321FD6109C, 0x371F77E76BB8417E, 0x6BFA9AAE5EC05779,
+   0xCD04F3FF001A4778, 0xE3273522064480CA, 0x9F91508BFFCFC14A, 0x049A7F41061A9E60,
+   0xFCB6BE43A9F2FE9B, 0x08DE8A1C7797DA9B, 0x8F9887E6078735A1, 0xB5B4071DBFC73A66,
+   0x230E343DFBA08D33, 0x43ED7F5A0FAE657D, 0x3A88A0FBBCB05C63, 0x21874B8B4D2DBC4F,
+   0x1BDEA12E35F6A8C9, 0x53C065C6C8E63528, 0xE34A1D250E7A8D6B, 0xD6B04D3B7651DD7E,
+   0x5E90277E7CB39E2D, 0x2C046F22062DC67D, 0xB10BB459132D0A26, 0x3FA9DDFB67E2F199,
+   0x0E09B88E1914F7AF, 0x10E8B35AF3EEAB37, 0x9EEDECA8E272B933, 0xD4C718BC4AE8AE5F,
+   0x81536D601170FC20, 0x91B534F885818A06, 0xEC8177F83F900978, 0x190E714FADA5156E,
+   0xB592BF39B0364963, 0x89C350C893AE7DC1, 0xAC042E70F8B383F2, 0xB49B52E587A1EE60,
+   0xFB152FE3FF26DA89, 0x3E666E6F69AE2C15, 0x3B544EBE544C19F9, 0xE805A1E290CF2456,
+   0x24B33C9D7ED25117, 0xE74733427B72F0C1, 0x0A804D18B7097475, 0x57E3306D881EDB4F,
+   0x4AE7D6A36EB5DBCB, 0x2D8D5432157064C8, 0xD1E649DE1E7F268B, 0x8A328A1CEDFE552C,
+   0x07A3AEC79624C7DA, 0x84547DDC3E203C94, 0x990A98FD5071D263, 0x1A4FF12616EEFC89,
+   0xF6F7FD1431714200, 0x30C05B1BA332F41C, 0x8D2636B81555A786, 0x46C9FEB55D120902,
+   0xCCEC0A73B49C9921, 0x4E9D2827355FC492, 0x19EBB029435DCB0F, 0x4659D2B743848A2C,
+   0x963EF2C96B33BE31, 0x74F85198B05A2E7D, 0x5A0F544DD2B1FB18, 0x03727073C2E134B1,
+   0xC7F6AA2DE59AEA61, 0x352787BAA0D7C22F, 0x9853EAB63B5E0B35, 0xABBDCDD7ED5C0860,
+   0xCF05DAF5AC8D77B0, 0x49CAD48CEBF4A71E, 0x7A4C10EC2158C4A6, 0xD9E92AA246BF719E,
+   0x13AE978D09FE5557, 0x730499AF921549FF, 0x4E4B705B92903BA4, 0xFF577222C14F0A3A,
+   0x55B6344CF97AAFAE, 0xB862225B055B6960, 0xCAC09AFBDDD2CDB4, 0xDAF8E9829FE96B5F,
+   0xB5FDFC5D3132C498, 0x310CB380DB6F7503, 0xE87FBB46217A360E, 0x2102AE466EBB1148,
+   0xF8549E1A3AA5E00D, 0x07A69AFDCC42261A, 0xC4C118BFE78FEAAE, 0xF9F4892ED96BD438,
+   0x1AF3DBE25D8F45DA, 0xF5B4B0B0D2DEEEB4, 0x962ACEEFA82E1C84, 0x046E3ECAAF453CE9,
+   0xF05D129681949A4C, 0x964781CE734B3C84, 0x9C2ED44081CE5FBD, 0x522E23F3925E319E,
+   0x177E00F9FC32F791, 0x2BC60A63A6F3B3F2, 0x222BBFAE61725606, 0x486289DDCC3D6780,
+   0x7DC7785B8EFDFC80, 0x8AF38731C02BA980, 0x1FAB64EA29A2DDF7, 0xE4D9429322CD065A,
+   0x9DA058C67844F20C, 0x24C0E332B70019B0, 0x233003B5A6CFE6AD, 0xD586BD01C5C217F6,
+   0x5E5637885F29BC2B, 0x7EBA726D8C94094B, 0x0A56A5F0BFE39272, 0xD79476A84EE20D06,
+   0x9E4C1269BAA4BF37, 0x17EFEE45B0DEE640, 0x1D95B0A5FCF90BC6, 0x93CBE0B699C2585D,
+   0x65FA4F227A2B6D79, 0xD5F9E858292504D5, 0xC2B5A03F71471A6F, 0x59300222B4561E00,
+   0xCE2F8642CA0712DC, 0x7CA9723FBB2E8988, 0x2785338347F2BA08, 0xC61BB3A141E50E8C,
+   0x150F361DAB9DEC26, 0x9F6A419D382595F4, 0x64A53DC924FE7AC9, 0x142DE49FFF7A7C3D,
+   0x0C335248857FA9E7, 0x0A9C32D5EAE45305, 0xE6C42178C4BBB92E, 0x71F1CE2490D20B07,
+   0xF1BCC3D275AFE51A, 0xE728E8C83C334074, 0x96FBF83A12884624, 0x81A1549FD6573DA5,
+   0x5FA7867CAF35E149, 0x56986E2EF3ED091B, 0x917F1DD5F8886C61, 0xD20D8C88C8FFE65F
+  ]
+
+castleKeys = Unboxed.fromList
+  [ 0x31D71DCE64B2C310, 0xF165B587DF898190
+  , 0xA57E6339DD2CF3A0, 0x1EF6E6DBB1961EC9
+  ]
+
+epKeys = Unboxed.fromList
+  [0x70CC73D90BC26E24,0xE21A6B35DF0C3AD7,0x003A93D8B2806962,0x1C99DED33CB890A1
+  ,0xCF3145DE0ADD4289,0xD0E4427A5514FB72,0x77C621CC9FB3A483,0x67A34DAC4356550B
+  ]
+
+turnKey :: Word64
+turnKey = 0xF8D626AAAF278509
diff --git a/src/Game/Chess/UCI.hs b/src/Game/Chess/UCI.hs
--- a/src/Game/Chess/UCI.hs
+++ b/src/Game/Chess/UCI.hs
@@ -3,42 +3,50 @@
   UCIException(..)
   -- * The Engine data type
 , Engine, name, author
-  -- * Starting and quitting a UCI engine
+  -- * Starting a UCI engine
 , start, start'
-, send
-, quit, quit'
   -- * Engine options
-, Option(..), options, getOption, setOptionSpinButton
+, Option(..), options, getOption, setOptionSpinButton, setOptionString
   -- * Manipulating the current game information
-, currentPosition, setPosition, addMove, move
-  -- * Reading engine output
-, Info(..), readInfo, tryReadInfo
-, readBestMove, tryReadBestMove
+, isready
+, currentPosition, setPosition, addPly
+  -- * The Info data type
+, Info(..), Score(..), Bounds(..)
+  -- * Searching
+, search, searching
+, SearchParam
+, searchmoves, timeleft, timeincrement, movestogo, movetime, nodes, depth, infinite
+, stop
+  -- * Quitting
+, quit, quit'
 ) where
 
 import Control.Applicative
 import Control.Concurrent
 import Control.Concurrent.STM
-import Control.Concurrent.STM.TChan
 import Control.Exception
 import Control.Monad
+import Control.Monad.IO.Class
 import Data.Attoparsec.Combinator
 import Data.Attoparsec.ByteString.Char8
+import Data.ByteString.Builder
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as BS
+import Data.Foldable
 import Data.Functor
 import Data.HashMap.Strict (HashMap)
 import qualified Data.HashMap.Strict as HashMap
 import Data.IORef
 import Data.Ix
 import Data.List
-import Data.Maybe
-import Data.String
+import Data.String (IsString(..))
 import Game.Chess
-import System.Exit
+import Numeric.Natural
+import System.Exit (ExitCode)
 import System.IO
 import System.Process
-import System.Timeout (timeout)
+import Time.Rational
+import Time.Units
 
 data Engine = Engine {
   inH :: Handle
@@ -50,33 +58,24 @@
 , author :: Maybe ByteString
 , options :: HashMap ByteString Option
 , isReady :: MVar ()
+, isSearching :: IORef Bool
 , infoChan :: TChan [Info]
-, bestMoveChan :: TChan (Move, Maybe Move)
-, game :: IORef (Position, [Move])
+, bestMoveChan :: TChan (Ply, Maybe Ply)
+, game :: IORef (Position, [Ply])
 }
 
-readInfo :: Engine -> STM [Info]
-readInfo = readTChan . infoChan
-
-tryReadInfo :: Engine -> STM (Maybe [Info])
-tryReadInfo = tryReadTChan . infoChan
-
-readBestMove :: Engine -> STM (Move, Maybe Move)
-readBestMove = readTChan . bestMoveChan
-
-tryReadBestMove :: Engine -> STM (Maybe (Move, Maybe Move))
-tryReadBestMove = tryReadTChan . bestMoveChan
-
 -- | Set the starting position of the current game, also clearing any
 -- pre-existing history.
-setPosition :: Engine -> Position -> IO ()
-setPosition e@Engine{game} p = do
-  atomicWriteIORef game (p, [])
+setPosition :: MonadIO m
+            => Engine -> Position
+            -> m (Position, [Ply])
+              -- ^ the game previously in progress
+setPosition e@Engine{game} p = liftIO $ do
+  oldGame <- atomicModifyIORef' game ((p, []),)
   sendPosition e
+  pure oldGame
 
-data UCIException = SANError String
-                  | IllegalMove Move
-                  deriving Show
+data UCIException = IllegalMove Ply deriving Show
 
 instance Exception UCIException
 
@@ -86,47 +85,55 @@
              | UCIOk
              | ReadyOK
              | Info [Info]
-             | BestMove !(Move, (Maybe Move))
+             | BestMove !(Ply, Maybe Ply)
              deriving (Show)
 
-data Info = PV [Move]
+data Info = PV [Ply]
           | Depth Int
           | SelDepth Int
-          | Time Int
+          | Elapsed (Time Millisecond)
           | MultiPV Int
-          | Score Int
-          | UpperBound
-          | LowerBound
+          | Score Score (Maybe Bounds)
           | Nodes Int
           | NPS Int
           | TBHits Int
           | HashFull Int
-          | CurrMove ByteString
+          | CurrMove Ply
           | CurrMoveNumber Int
-          deriving Show
+          | String ByteString
+          deriving (Eq, Show)
 
+data Score = CentiPawns Int
+           | MateIn Int
+           deriving (Eq, Ord, Show)
+           
+data Bounds = UpperBound | LowerBound deriving (Eq, Show)
+
+
 data Option = CheckBox Bool
             | ComboBox { comboBoxValue :: ByteString, comboBoxValues :: [ByteString] }
             | SpinButton { spinButtonValue, spinButtonMinBound, spinButtonMaxBound :: Int }
-            | String ByteString
+            | OString ByteString
             | Button
             deriving (Eq, Show)
 
 instance IsString Option where
-  fromString = String . BS.pack
+  fromString = OString . BS.pack
 
 command :: Position -> Parser Command
-command pos = skipSpace *> choice [
-    name, author, option, uciok, readyok, info, bestmove
+command pos = skipSpace *> choice
+  [ "id" `kv` name
+  , "id" `kv` author
+  , "option" `kv` option
+  , "uciok" $> UCIOk
+  , "readyok" $> ReadyOK
+  , "info" `kv` fmap Info (sepBy1 infoItem skipSpace)
+  , "bestmove" `kv` bestmove
   ] <* skipSpace
  where
-  name = fmap Name $
-    "id" *> skipSpace *> "name" *> skipSpace *> takeByteString
-  author = fmap Author $
-    "id" *> skipSpace *> "author" *> skipSpace *> takeByteString
+  name = Name <$> kv "name" takeByteString
+  author = Author <$> kv "author" takeByteString
   option = do
-    void "option"
-    skipSpace
     void "name"
     skipSpace
     optName <- BS.pack <$> manyTill anyChar (skipSpace *> "type")
@@ -151,77 +158,77 @@
                            <*> takeByteString
     pure $ ComboBox def (map BS.pack vars <> [lastVar])
   var = skipSpace *> "var" *> skipSpace
-  str = fmap String $
+  str = fmap OString $
     "string" *> skipSpace *> "default" *> skipSpace *> takeByteString
   button = "button" $> Button
-  uciok = "uciok" $> UCIOk
-  readyok = "readyok" $> ReadyOK
-  info = do
-    "info"
-    skipSpace
-    Info <$> sepBy1 infoItem skipSpace
-  infoItem = Depth <$> ("depth" *> skipSpace *> decimal)
-         <|> SelDepth <$> ("seldepth" *> skipSpace *> decimal)
-         <|> MultiPV <$> ("multipv" *> skipSpace *> decimal)
-         <|> Score <$> ("score" *> skipSpace *> "cp" *> skipSpace *> signed decimal)
-         <|> UpperBound <$ "upperbound"
-         <|> LowerBound <$ "lowerbound"
-         <|> Nodes <$> ("nodes" *> skipSpace *> decimal)
-         <|> NPS <$> ("nps" *> skipSpace *> decimal)
-         <|> HashFull <$> ("hashfull" *> skipSpace *> decimal)
-         <|> TBHits <$> ("tbhits" *> skipSpace *> decimal)
-         <|> Time <$> ("time" *> skipSpace *> decimal)
-         <|> pv
-         <|> CurrMove <$> ("currmove" *> skipSpace *> mv)
-         <|> CurrMoveNumber <$> ("currmovenumber" *> skipSpace *> decimal)
-  pv = do
-    xs <- (fmap . fmap) BS.unpack $ "pv" *> skipSpace *> sepBy mv skipSpace
-    PV . snd <$> foldM toMove (pos, []) xs
-  toMove (pos, xs) s = do
-    case fromUCI pos s of
-      Just m -> pure (applyMove pos m, xs <> [m])
-      Nothing -> fail $ "Failed to parse move " <> s
-  mv = fmap fst $ match $ satisfy f *> satisfy r *> satisfy f *> satisfy r *> optional (satisfy p) where
-    f = inRange ('a','h')
-    r = inRange ('1', '8')
+  infoItem = Depth <$> kv "depth" decimal
+         <|> SelDepth <$> kv "seldepth" decimal
+         <|> MultiPV <$> kv "multipv" decimal
+         <|> kv "score" score
+         <|> Nodes <$> kv "nodes" decimal
+         <|> NPS <$> kv "nps" decimal
+         <|> HashFull <$> kv "hashfull" decimal
+         <|> TBHits <$> kv "tbhits" decimal
+         <|> Elapsed . ms . fromIntegral <$> kv "time" decimal
+         <|> kv "pv" pv
+         <|> kv "currmove" currmove
+         <|> CurrMoveNumber <$> kv "currmovenumber" decimal
+         <|> String <$> kv "string" takeByteString
+  score = do
+    s <- kv "cp" (CentiPawns <$> signed decimal)
+     <|> kv "mate" (MateIn <$> signed decimal)
+    b <- optional $ skipSpace *> (  UpperBound <$ "upperbound"
+                                <|> LowerBound <$ "lowerbound"
+                                 )
+    pure $ Score s b
+  pv = fmap (PV . snd) $ foldM toPly (pos, []) =<< sepBy mv skipSpace
+  toPly (pos, xs) s = case fromUCI pos s of
+    Just m -> pure (doPly pos m, xs <> [m])
+    Nothing -> fail $ "Failed to parse move " <> s
+  currmove = fmap (fromUCI pos) mv >>= \case
+    Just m -> pure $ CurrMove m
+    Nothing -> fail "Failed to parse move"
+
+  mv = BS.unpack . fst <$> match (sq *> sq *> optional (satisfy p)) where
+    sq = satisfy (inRange ('a', 'h')) *> satisfy (inRange ('1', '8'))
     p 'q' = True
     p 'r' = True
     p 'b' = True
     p 'n' = True
     p _ = False 
   bestmove = do
-    void "bestmove"
-    skipSpace
-    m <- BS.unpack <$> mv
-    ponder <- (fmap . fmap) BS.unpack $
-              optional (skipSpace *> "ponder" *> skipSpace *> mv)
+    m <- mv
+    ponder <- optional (skipSpace *> kv "ponder" mv)
     case fromUCI pos m of
       Just m' -> case ponder of
         Nothing -> pure $ BestMove (m', Nothing)
-        Just p -> case fromUCI (applyMove pos m') p of
-          Just p' -> pure $ BestMove (m', (Just p'))
+        Just p -> case fromUCI (doPly pos m') p of
+          Just p' -> pure $ BestMove (m', Just p')
           Nothing -> fail $ "Failed to parse ponder move " <> p
       Nothing -> fail $ "Failed to parse best move " <> m
+  kv k v = k *> skipSpace *> v
 
 -- | Start a UCI engine with the given executable name and command line arguments.
 start :: String -> [String] -> IO (Maybe Engine)
-start = start' 2000000 putStrLn
+start = start' (sec 2) putStrLn
 
 -- | Start a UCI engine with the given timeout for initialisation.
 --
 -- If the engine takes more then the given microseconds to answer to the
 -- initialisation request, 'Nothing' is returned and the external process
 -- will be terminated.
-start' :: Int -> (String -> IO ()) -> String -> [String] -> IO (Maybe Engine)
-start' usec outputStrLn cmd args = do
+start' :: KnownDivRat unit Microsecond => Time unit -> (String -> IO ()) -> String -> [String] -> IO (Maybe Engine)
+start' tout outputStrLn cmd args = do
   (Just inH, Just outH, Nothing, procH) <- createProcess (proc cmd args) {
       std_in = CreatePipe, std_out = CreatePipe
     }
   hSetBuffering inH LineBuffering
   e <- Engine inH outH procH outputStrLn Nothing Nothing Nothing HashMap.empty <$>
-       newEmptyMVar <*> newTChanIO <*> newTChanIO <*> newIORef (startpos, [])
-  send "uci" e
-  timeout usec (initialise e) >>= \case
+       newEmptyMVar <*> newIORef False <*>
+       newBroadcastTChanIO <*> newBroadcastTChanIO <*>
+       newIORef (startpos, [])
+  send e "uci"
+  timeout tout (initialise e) >>= \case
     Just e' -> do
       tid <- forkIO . infoReader $ e'
       pure . Just $ e' { infoThread = Just tid }
@@ -232,7 +239,7 @@
   l <- BS.hGetLine outH
   pos <- fst <$> readIORef game
   if BS.null l then initialise c else case parseOnly (command pos <* endOfInput) l of
-    Left err -> do
+    Left _ -> do
       outputStrLn . BS.unpack $ l
       initialise c
     Right (Name n) -> initialise (c { name = Just n })
@@ -245,97 +252,152 @@
   l <- BS.hGetLine outH
   pos <- currentPosition e
   case parseOnly (command pos <* endOfInput) l of
-    Left err -> do
-      outputStrLn $ err <> ":" <> show l
+    Left err -> outputStrLn $ err <> ":" <> show l
     Right ReadyOK -> putMVar isReady ()
     Right (Info i) -> atomically $ writeTChan infoChan i
-    Right (BestMove bm) -> atomically $ writeTChan bestMoveChan bm
+    Right (BestMove bm) -> do
+      writeIORef isSearching False
+      atomically $ writeTChan bestMoveChan bm
 
 -- | Wait until the engine is ready to take more commands.
 isready :: Engine -> IO ()
 isready e@Engine{isReady} = do
-  send "isready" e
+  send e "isready"
   takeMVar isReady
   
--- | Send a command to the engine.
---
--- This function is likely going to be removed and replaced by more specific
--- functions in the future.
-send :: ByteString -> Engine -> IO ()
-send s Engine{inH, procH} = do
-  BS.hPutStrLn inH s
+send :: Engine -> Builder -> IO ()
+send Engine{inH, procH} b = do
+  hPutBuilder inH (b <> "\n")
   getProcessExitCode procH >>= \case
     Nothing -> pure ()
     Just ec -> throwIO ec
 
+data SearchParam = SearchMoves [Ply]
+                -- ^ restrict search to the specified moves only
+                 | TimeLeft Color (Time Millisecond)
+                -- ^ time (in milliseconds) left on the clock
+                 | TimeIncrement Color (Time Millisecond)
+                -- ^ time increment per move in milliseconds
+                 | MovesToGo Natural
+                -- ^ number of moves to the next time control
+                 | MoveTime (Time Millisecond)
+                 | MaxNodes Natural
+                 | MaxDepth Natural
+                 | Infinite
+                -- ^ search until 'stop' gets called
+                 deriving (Eq, Show)
+ 
+searchmoves :: [Ply] -> SearchParam
+searchmoves = SearchMoves
+
+timeleft, timeincrement :: KnownDivRat unit Millisecond
+                        => Color -> Time unit -> SearchParam
+timeleft c = TimeLeft c . toUnit
+timeincrement c = TimeIncrement c . toUnit
+
+movestogo :: Natural -> SearchParam
+movestogo = MovesToGo
+
+movetime :: KnownDivRat unit Millisecond => Time unit -> SearchParam
+movetime = MoveTime . toUnit
+
+nodes, depth :: Natural -> SearchParam
+nodes = MaxNodes
+depth = MaxDepth
+
+infinite :: SearchParam
+infinite = Infinite
+
+searching :: MonadIO m => Engine -> m Bool
+searching Engine{isSearching} = liftIO $ readIORef isSearching
+
+-- | Instruct the engine to begin searching.
+search :: MonadIO m
+       => Engine -> [SearchParam]
+       -> m (TChan (Ply, Maybe Ply), TChan [Info])
+search e@Engine{isSearching} params = liftIO $ do
+  chans <- atomically $ (,) <$> dupTChan (bestMoveChan e)
+                            <*> dupTChan (infoChan e)
+  send e . fold . intersperse " " $ "go" : foldr build mempty params
+  writeIORef isSearching True
+  pure chans
+ where
+  build (SearchMoves ms) xs = "searchmoves" : (fromString . toUCI <$> ms) <> xs
+  build (TimeLeft White (floor . unTime -> x)) xs = "wtime" : integerDec x : xs
+  build (TimeLeft Black (floor . unTime -> x)) xs = "btime" : integerDec x : xs
+  build (TimeIncrement White (floor . unTime -> x)) xs = "winc" : integerDec x : xs
+  build (TimeIncrement Black (floor . unTime -> x)) xs = "binc" : integerDec x : xs
+  build (MovesToGo x) xs = "movestogo" : naturalDec x : xs
+  build (MoveTime (floor . unTime -> x)) xs = "movetime" : integerDec x : xs
+  build (MaxNodes x) xs = "nodes" : naturalDec x : xs
+  build (MaxDepth x) xs = "depth" : naturalDec x : xs
+  build Infinite xs = "infinite" : xs
+  naturalDec = integerDec . toInteger
+
+-- | Stop a search in progress.
+stop :: MonadIO m => Engine -> m ()
+stop e = liftIO $ send e "stop"
+
 getOption :: ByteString -> Engine -> Maybe Option
 getOption n = HashMap.lookup n . options
 
 -- | Set a spin option to a particular value.
 --
 -- Bounds are validated.  Make sure you don't set a value which is out of range.
-setOptionSpinButton :: ByteString -> Int -> Engine -> IO Engine
+setOptionSpinButton :: MonadIO m => ByteString -> Int -> Engine -> m Engine
 setOptionSpinButton n v c
   | Just (SpinButton _ minValue maxValue) <- getOption n c
   , inRange (minValue, maxValue) v
-  = do
-    send ("setoption name " <> n <> " value " <> BS.pack (show v)) c
+  = liftIO $ do
+    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 }
 
+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
+
 -- | Return the final position of the currently active game.
-currentPosition :: Engine -> IO Position
-currentPosition Engine{game} =
-  uncurry (foldl' applyMove) <$> readIORef game
+currentPosition :: MonadIO m => Engine -> m Position
+currentPosition Engine{game} = liftIO $
+  uncurry (foldl' doPly) <$> readIORef game
 
 nextMove :: Engine -> IO Color
 nextMove Engine{game} = do
   (initialPosition, history) <- readIORef game
   pure $ if even . length $ history then color initialPosition else opponent . color $ initialPosition
 
--- | Add the given move (in algebraic notation) to the current game.
-move :: Engine -> String -> IO ()
-move e@Engine{game} s = do
-  pos <- currentPosition e
-  case fromUCI pos s of
-    Just m -> do
-      addMove e m
-      sendPosition e
-    Nothing -> case fromSAN pos s of
-      Left err -> throwIO $ SANError err
-      Right m -> do
-        addMove e m
-        sendPosition e
-
 -- | Add a 'Move' to the game history.
 --
 -- This function checks if the move is actually legal, and throws a 'UCIException'
 -- if it isn't.
-addMove :: Engine -> Move -> IO ()
-addMove e@Engine{game} m = do
+addPly :: MonadIO m => Engine -> Ply -> m ()
+addPly e@Engine{game} m = liftIO $ do
   pos <- currentPosition e
-  if m `elem` moves pos
-    then atomicModifyIORef' game \g -> (fmap (<> [m]) g, ())
-    else throwIO $ IllegalMove m
-    
+  if m `notElem` legalPlies pos then throwIO $ IllegalMove m else do
+    atomicModifyIORef' game $ \g -> (fmap (<> [m]) g, ())
+    sendPosition e
+ 
 sendPosition :: Engine -> IO ()
-sendPosition e@Engine{game} = do
-  readIORef game >>= (flip send) e . cmd
- where
-  cmd (p, h) = "position fen " <> BS.pack (toFEN p) <> line h
-  line h
-    | null h    = ""
-    | otherwise = " moves " <> BS.unwords (BS.pack . toUCI <$> h)
+sendPosition e@Engine{game} = readIORef game >>= send e . cmd where
+  cmd (p, h) = fold . intersperse " " $
+    "position" : "fen" : fromString (toFEN p) : line h
+  line [] = []
+  line h = "moves" : (fromString . toUCI <$> h)
 
 -- | Quit the engine.
-quit :: Engine -> IO (Maybe ExitCode)
-quit = quit' 1000000
+quit :: MonadIO m => Engine -> m (Maybe ExitCode)
+quit = quit' (sec 1)
 
-quit' :: Int -> Engine -> IO (Maybe ExitCode)
-quit' usec c@Engine{procH, infoThread} = (pure . Just) `handle` do
+quit' :: (KnownDivRat unit Microsecond, MonadIO m)
+      => Time unit -> Engine -> m (Maybe ExitCode)
+quit' t e@Engine{procH, infoThread} = liftIO $ (pure . Just) `handle` do
   maybe (pure ()) killThread infoThread
-  send "quit" c
-  timeout usec (waitForProcess procH) >>= \case
+  send e "quit"
+  timeout t (waitForProcess procH) >>= \case
     Just ec -> pure $ Just ec
     Nothing -> terminateProcess procH $> Nothing
diff --git a/test/Perft.hs b/test/Perft.hs
--- a/test/Perft.hs
+++ b/test/Perft.hs
@@ -3,6 +3,7 @@
 import Control.Parallel.Strategies
 import Data.Foldable
 import Data.Maybe
+import Data.Monoid
 import Data.Time.Clock
 import Data.Traversable
 import Game.Chess
@@ -47,14 +48,15 @@
 
 perft :: Int -> Position -> PerftResult
 perft 0 _ = PerftResult 1
-perft 1 p = PerftResult . fromIntegral . length $
-            unsafeApplyMove p <$> moves p
-perft 2 p = fold . map (perft 1) $ unsafeApplyMove p <$> moves p
-perft n p = fold . withStrategy (parList rdeepseq) . map (perft $ pred n) $
-            unsafeApplyMove p <$> moves p
+perft 1 p = PerftResult . fromIntegral . length $ legalPlies p
+perft n p
+  | n < 4
+  = foldMap (perft (pred n) . unsafeDoPly p) $ legalPlies p
+  | otherwise
+  = fold . parMap rdeepseq (perft (pred n) . unsafeDoPly p) $ legalPlies p
 
 runTestSuite :: [(Position, [(Int, PerftResult)])] -> IO (Maybe PerftResult)
-runTestSuite = fmap fold . traverse (uncurry (test mempty)) where
+runTestSuite = fmap (getAp . foldMap Ap) . traverse (uncurry (test mempty)) where
   test sum pos ((depth, expected) : more)
     | result == expected
     = do