diff --git a/CHANGELOG.md b/CHANGELOG.md
new file mode 100644
--- /dev/null
+++ b/CHANGELOG.md
@@ -0,0 +1,14 @@
+# Releases
+
+## chessIO 0.5.0.0
+
+- Split SAN parsing code into a separate module.
+- Adapt to VisualStream change in Megaparsec >= 9.
+- Use Maybe to indicate that bestmove in UCI can be empty.
+- instance Storable QuadBitboard
+
+## chessIO 0.4.0.0
+
+- Support for letting UCI engines ponder.
+- Avoid a branch to further speed up move generation.
+
diff --git a/README.md b/README.md
new file mode 100644
--- /dev/null
+++ b/README.md
@@ -0,0 +1,30 @@
+# A Haskell chess library and console UCI frontend program
+
+`chessIO` is a Haskell library for working with chess positions and moves,
+and a console frontend program (cboard) to work with UCI compatible
+chess engines.
+
+## The Library
+
+The main module provided by the library is
+[Game.Chess](https://hackage.haskell.org/package/chessIO/docs/Game-Chess.html),
+which defines data types and functions for working with chess positions
+and moves. It offers a fully compliant move generator and parsing for
+and printing positions in [Forsyth-Edwards
+Notation](https://en.wikipedia.org/wiki/Forsyth%E2%80%93Edwards_Notation)
+and moves in [Algebraic
+Notation](https://en.wikipedia.org/wiki/Algebraic_notation_(chess)).
+
+Module
+[Game.Chess.UCI](https://hackage.haskell.org/package/chessIO/docs/Game-Chess-UCI.html)
+provides functionality to run an external process which understands the
+Universal Chess Interface protocol from within Haskell.
+
+## Console frontend for the Universal Chess Interface protocl
+
+`cboard` is a simple console (text-mode) frontend for interacting with
+chess engines (like stockfish or glaurung) which make use of the UCI
+protocol.
+
+To launch a chess engine, simply pass its executable name and arguments
+to cboard. For instance, `cboard stockfish`.
diff --git a/README.rst b/README.rst
deleted file mode 100644
--- a/README.rst
+++ /dev/null
@@ -1,30 +0,0 @@
-chessIO -- A Haskell chess library and console UCI frontend program
-===================================================================
-
-chessIO is a Haskell library for working with chess positions and moves, and a
-console frontend program (cboard) to work with UCI compatible chess engines.
-
-The Library
------------
-
-The main module provided by the library is Game.Chess_, which defines
-data types and functions for working with chess positions and moves.
-It offers a fully compliant move generator and parsing for and printing
-positions in `Forsyth-Edwards Notation`_ and moves in `Algebraic Notation`_.
-
-Module Game.Chess.UCI_ provides functionality to run an external process
-which understands the Universal Chess Interface protocol from within Haskell.
-
-cboard -- Console frontend for the Universal Chess Interface protocl
---------------------------------------------------------------------
-
-cboard is a simple console (text-mode) frontend for interacting with chess engines
-(like stockfish or glaurung) which make use of the UCI protocol.
-
-To launch a chess engine, simply pass its executable name and arguments
-to cboard.  For instance, `cboard stockfish`.
-
-.. _`Forsyth-Edwards Notation`: https://en.wikipedia.org/wiki/Forsyth%E2%80%93Edwards_Notation
-.. _`Algebraic Notation`: https://en.wikipedia.org/wiki/Algebraic_notation_(chess)
-.. _Game.Chess: https://hackage.haskell.org/package/chessIO/docs/Game-Chess.html
-.. _Game.Chess.UCI: https://hackage.haskell.org/package/chessIO/docs/Game-Chess-UCI.html
diff --git a/app/cboard.hs b/app/cboard.hs
--- a/app/cboard.hs
+++ b/app/cboard.hs
@@ -1,24 +1,54 @@
 module Main where
 
 import Control.Arrow ((&&&))
-import Control.Concurrent
-import Control.Concurrent.STM
-import Control.Monad
-import Control.Monad.Extra hiding (loop)
-import Control.Monad.IO.Class
-import Control.Monad.Random
+import Control.Concurrent ( forkIO, killThread, ThreadId )
+import Control.Concurrent.STM ( atomically, readTChan, TChan )
+import Control.Monad ( forever, void )
+import Control.Monad.Extra ( ifM, unlessM )
+import Control.Monad.IO.Class ( MonadIO(..) )
+import Control.Monad.Random ( evalRandIO, MonadTrans(lift) )
 import Control.Monad.State.Strict
-import Data.Char
-import Data.IORef
-import Data.List
-import Data.List.Extra
+    ( StateT, evalStateT, gets, modify, modify' )
+import Data.Char ( toLower, toUpper )
+import Data.IORef ( newIORef, readIORef, writeIORef, IORef )
+import Data.List ( find, isPrefixOf )
+import Data.List.Extra ( chunksOf )
 import Game.Chess
-import Game.Chess.Polyglot.Book (PolyglotBook, defaultBook, readPolyglotFile, bookPlies, bookPly)
+    ( fromFEN, fromUCI, isDark, legalPlies, pieceAt, startpos, fromSAN, toSAN,
+      unsafeToSAN, Color(Black, White),
+      PieceType(King, Pawn, Knight, Bishop, Rook, Queen),
+      Ply, Position, Sq(H8, A1), varToSAN )
+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 Time.Units
+    ( addPly,
+      currentPosition,
+      infinite,
+      movetime,
+      quit,
+      search,
+      searching,
+      setPosition,
+      start,
+      stop,
+      Engine,
+      BestMove, Info(Score, PV) )
+import System.Console.Haskeline
+    ( defaultSettings,
+      getExternalPrint,
+      getInputLine,
+      outputStr,
+      outputStrLn,
+      completeWord,
+      simpleCompletion,
+      runInputT,
+      setComplete,
+      Completion(isFinished),
+      CompletionFunc,
+      InputT )
+import System.Exit ( ExitCode(ExitFailure), exitSuccess, exitWith )
+import System.Environment ( getArgs )
+import Time.Units ( ms, sec )
 
 data S = S {
   engine :: Engine
@@ -77,10 +107,12 @@
       pl <- liftIO . evalRandIO $ r
       addPly e pl
       (bmc, _) <- search e [movetime (ms 100)]
-      liftIO $ do
-        (bm, _) <- atomically . readTChan $ bmc
-        addPly e bm
-      midgame
+      bm <- liftIO . atomically . readTChan $ bmc
+      case bm of
+        Just (bm', _) -> do
+          addPly e bm'
+          midgame
+        Nothing -> outputBoard
     Nothing -> outputBoard
 
 outputBoard :: InputT (StateT S IO) ()
@@ -125,12 +157,14 @@
             info <- atomically . readTChan $ ic
             case (find isScore &&& find isPV) info of
               (Just (Score s Nothing), Just (PV pv)) ->
-                externalPrint $ show s <> ": " <> varToString pos pv
+                externalPrint $ show s <> ": " <> varToSAN pos pv
               _ -> pure ()
           tid <- liftIO . forkIO $ do
-            (bm, _) <- atomically . readTChan $ bmc
+            bm <- atomically . readTChan $ bmc
             killThread itid
-            externalPrint $ "Best move: " <> toSAN pos bm
+            case bm of
+              Just (bm', _) -> externalPrint $ "Best move: " <> toSAN pos bm'
+              Nothing -> pure ()
           lift $ modify' $ \s -> s { mover = Just tid }
         loop
       | "stop" == input -> do
@@ -174,22 +208,6 @@
   tid <- liftIO . forkIO $ doBestMove externalPrint hr bmc e
   lift $ modify' $ \s -> s { mover = Just tid }
 
-varToString :: Position -> [Ply] -> String
-varToString _ [] = ""
-varToString pos plies
-  | color pos == Black && length plies == 1
-  = show (moveNumber pos) <> "..." <> toSAN pos (head plies)
-  | color pos == Black
-  = show (moveNumber pos) <> "..." <> toSAN pos (head plies) <> " " <> fromWhite (doPly pos (head plies)) (tail plies)
-  | otherwise
-  = fromWhite pos plies
- 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
-  f _ [] = []
-
 parseMove :: Position -> String -> Either String Ply
 parseMove pos s = case fromUCI pos s of
   Just m -> pure m
@@ -217,16 +235,19 @@
 
 doBestMove :: (String -> IO ())
            -> IORef (Maybe Ply)
-           -> TChan (Ply, Maybe Ply)
+           -> TChan BestMove
            -> Engine
            -> IO ()
 doBestMove externalPrint hintRef bmc e = do
-  (bm, pndr) <- atomically . readTChan $ bmc
-  pos <- currentPosition e
-  externalPrint $ "< " <> toSAN pos bm
-  addPly e bm
-  currentPosition e >>= printBoard externalPrint
-  writeIORef hintRef pndr
+  bm <- atomically . readTChan $ bmc
+  case bm of
+    Just (bm', pndr) -> do
+      pos <- currentPosition e
+      externalPrint $ "< " <> toSAN pos bm'
+      addPly e bm'
+      currentPosition e >>= printBoard externalPrint
+      writeIORef hintRef pndr
+    Nothing -> pure ()
 
 printPV :: (String -> IO ()) -> TChan [Info] -> IO ()
 printPV externalPrint ic = forever $ do
diff --git a/app/polyplay.hs b/app/polyplay.hs
--- a/app/polyplay.hs
+++ b/app/polyplay.hs
@@ -4,7 +4,6 @@
 import Control.Concurrent.STM
 import Control.Monad
 import Control.Monad.Random
-import Data.Maybe (isJust, maybe)
 import Data.IORef
 import Data.List
 import Data.String
@@ -17,6 +16,7 @@
 import Game.Chess.Polyglot.Book
 import Game.Chess.UCI
 import Options.Applicative
+import System.IO (hPutStrLn, stderr)
 import Time.Units
 
 data Clock = Clock !Color !NominalDiffTime !NominalDiffTime !UTCTime
@@ -60,14 +60,14 @@
 data Runtime = Runtime {
   book :: PolyglotBook
 , history :: (Position, [Ply])
-, active :: Player Active
-, passive :: Player Passive
+, active :: !(Player Active)
+, passive :: !(Player Passive)
 , clock :: !Clock
 }
 
 data Player s = Player Engine (Maybe s)
-data Active = Searching (TChan (Ply, Maybe Ply)) (TChan [Info])
-data Passive = Pondering Ply (TChan (Ply, Maybe Ply)) (TChan [Info])
+data Active = Searching (TChan BestMove) (TChan [Info])
+data Passive = Pondering Ply (TChan BestMove) (TChan [Info])
 
 opts :: Parser Polyplay
 opts = Polyplay <$> option auto (long "hash" <> metavar "MB" <> value 1024)
@@ -84,8 +84,8 @@
 run :: (Runtime -> IO ()) -> Polyplay -> IO ()
 run f Polyplay{..} = do
   book <- readPolyglotFile bookFile
-  start engineProgram engineArgs >>= \case
-    Nothing -> putStrLn "Engine failed to start."
+  start' (sec 30) putLog engineProgram engineArgs >>= \case
+    Nothing -> putLog "Engine failed to start."
     Just e1 -> do
       _ <- setOptionSpinButton "Hash" hashSize e1
       _ <- setOptionSpinButton "Threads" threadCount e1
@@ -93,8 +93,8 @@
         Just fp -> void $ setOptionString "SyzygyPath" (fromString fp) e1
         Nothing -> pure ()
       isready e1
-      start engineProgram engineArgs >>= \case
-        Nothing -> putStrLn "Engine failed to start secondary engine."
+      start' (sec 30) putLog engineProgram engineArgs >>= \case
+        Nothing -> putLog "Engine failed to start secondary engine."
         Just e2 -> do
           _ <- setOptionSpinButton "Hash" hashSize e2
           _ <- setOptionSpinButton "Threads" threadCount e2
@@ -120,88 +120,94 @@
   putDoc (gameDoc breadthFirst g)
   pure ()
 
-done :: Position -> Bool
-done = null . legalPlies
+checkmate, stalemate, draw :: Position -> Bool
+checkmate pos = null (legalPlies pos) && inCheck (color pos) pos
+stalemate pos = null (legalPlies pos) && not (inCheck (color pos) pos)
+draw pos = insufficientMaterial pos || stalemate pos
 
 play :: Runtime -> IO ([Ply], Outcome)
 play rt@Runtime{book, history, active, passive, clock} = do
-  let pos = uncurry (foldl' doPly) history
+  let pos = uncurry (foldl' unsafeDoPly) history
+  let poss = snd $ uncurry (mapAccumL (\p pl -> (unsafeDoPly p pl, p))) history
   clockRemaining clock (color pos) >>= \case
     Nothing -> pure (snd history, Win . opponent . color $ pos)
     Just _ ->
-      if done pos
-      then pure (snd history, Win . opponent . color $ pos)
-      else
-      case bookPly book pos of
-        Just r -> do
-          pl <- evalRandIO r
-          let history' = fmap (<> [pl]) history
-          p2 <- case active of
-            Player e1 Nothing -> do
-              addPly e1 pl
-              pure $ Player e1 Nothing
-            Player e1 (Just (Searching bmc ic)) -> do
-              stop e1
-              atomically . readTChan $ bmc
-              addPly e1 pl
-              pure $ Player e1 Nothing
-          p1 <- case passive of
-            Player e2 Nothing -> do
-              addPly e2 pl
-              pure $ Player e2 Nothing
-            Player e2 (Just (Pondering _ bmc ic)) -> do
-              stop e2
-              atomically . readTChan $ bmc
-              replacePly e2 pl
-              pure $ Player e2 Nothing
-          clock' <- flipClock clock
-          putStrLn $ "Book: " <> toSAN pos pl
-          play (rt { history = history', active = p1, passive = p2, clock = clock' })
-        Nothing -> do
-          case active of
-            Player e1 Nothing -> do
-              let (Just wt, Just bt) = clockTimes clock
-              (bmc, ic) <- search e1 [timeleft White wt, timeleft Black bt]
-              play $ rt { active = Player e1 (Just (Searching bmc ic)) }
-            Player e1 (Just (Searching bmc ic)) -> do
-              sc <- newIORef Nothing
-              itid <- liftIO . forkIO . forever $ do
-                i <- atomically . readTChan $ ic
-                case find isScore i of
-                  Just (Score s _) -> writeIORef sc (Just s)
-                  _ -> pure ()
-              (bm, pndr) <- atomically . readTChan $ bmc
-              killThread itid
-              sc <- readIORef sc
-              let history' = fmap (<> [bm]) history
-              clock' <- flipClock clock
-              addPly e1 bm
-              p1 <- case passive of
-                Player e2 Nothing -> do
-                  addPly e2 bm
-                  putStrLn $ "Move: " <> toSAN pos bm <> " (" <> show sc <> ")"
-                  pure $ Player e2 Nothing
-                Player e2 (Just (Pondering pndr bmc ic)) -> do
-                  if bm == pndr
-                  then do
-                    ponderhit e2
-                    putStrLn $ "Ponderhit: " <> toSAN pos bm <> " (" <> show sc <> ")"
-                    pure $ Player e2 (Just (Searching bmc ic))
-                  else do
-                    stop e2
-                    atomically . readTChan $ bmc
-                    replacePly e2 bm
-                    putStrLn $ "Pondermiss: " <> toSAN pos bm <> " (" <> show sc <> ")"
-                    pure $ Player e2 Nothing
-              p2 <- case pndr of
-                Just pndr -> do
-                  addPly e1 pndr
-                  let (Just wt, Just bt) = clockTimes clock'
-                  (bmc, ic) <- search e1 [ponder, timeleft White wt, timeleft Black bt]
-                  pure $ Player e1 (Just (Pondering pndr bmc ic))
-                Nothing -> 
-                  pure $ Player e1 Nothing
-              play $ rt { history = history', active = p1, passive = p2, clock = clock' }
+      if | draw pos    -> pure (snd history, Draw)
+         | checkmate pos -> pure (snd history, Win . opponent . color $ pos)
+         | Just (n, _) <- repetitions poss
+         , n >= 3        -> pure (snd history, Draw)
+         | otherwise     -> case bookPly book pos of
+             Just r -> do
+               pl <- evalRandIO r
+               let history' = fmap (<> [pl]) history
+               p2 <- case active of
+                 Player e1 Nothing -> do
+                   addPly e1 pl
+                   pure $ Player e1 Nothing
+                 Player e1 (Just (Searching bmc _ic)) -> do
+                   stop e1
+                   void . atomically . readTChan $ bmc
+                   addPly e1 pl
+                   pure $ Player e1 Nothing
+               p1 <- case passive of
+                 Player e2 Nothing -> do
+                   addPly e2 pl
+                   pure $ Player e2 Nothing
+                 Player e2 (Just (Pondering _ bmc _ic)) -> do
+                   stop e2
+                   void . atomically . readTChan $ bmc
+                   replacePly e2 pl
+                   pure $ Player e2 Nothing
+               clock' <- flipClock clock
+               putLog $ "Book: " <> toSAN pos pl
+               play (rt { history = history', active = p1, passive = p2, clock = clock' })
+             Nothing -> do
+               case active of
+                 Player e1 Nothing -> do
+                   let (Just wt, Just bt) = clockTimes clock
+                   (bmc, ic) <- search e1 [timeleft White wt, timeleft Black bt]
+                   play $ rt { active = Player e1 (Just (Searching bmc ic)) }
+                 Player e1 (Just (Searching bmc ic)) -> do
+                   sc <- newIORef Nothing
+                   itid <- liftIO . forkIO . forever $ do
+                     i <- atomically . readTChan $ ic
+                     case find isScore i of
+                       Just (Score s _) -> writeIORef sc (Just s)
+                       _ -> pure ()
+                   mbm <- atomically . readTChan $ bmc
+                   killThread itid
+                   sc <- readIORef sc
+                   case mbm of
+                     Just (bm, pndr) -> do
+                       let history' = fmap (<> [bm]) history
+                       clock' <- flipClock clock
+                       addPly e1 bm
+                       p1 <- case passive of
+                         Player e2 Nothing -> do
+                           addPly e2 bm
+                           putLog $ "Move: " <> toSAN pos bm <> " (" <> show sc <> ")"
+                           pure $ Player e2 Nothing
+                         Player e2 (Just (Pondering pndr bmc ic)) -> do
+                           if bm == pndr
+                             then do
+                               ponderhit e2
+                               putLog $ "Ponderhit: " <> toSAN pos bm <> " (" <> show sc <> ")"
+                               pure $ Player e2 (Just (Searching bmc ic))
+                             else do
+                               stop e2
+                               atomically . readTChan $ bmc
+                               replacePly e2 bm
+                               putLog $ "Pondermiss: " <> toSAN pos bm <> " (" <> show sc <> ")"
+                               pure $ Player e2 Nothing
+                       p2 <- case pndr of
+                         Just pndr -> do
+                           addPly e1 pndr
+                           let (Just wt, Just bt) = clockTimes clock'
+                           (bmc, ic) <- search e1 [ponder, timeleft White wt, timeleft Black bt]
+                           pure $ Player e1 (Just (Pondering pndr bmc ic))
+                         Nothing -> pure $ Player e1 Nothing
+                       play $ rt { history = history', active = p1, passive = p2, clock = clock' }
+                     Nothing -> pure (snd history, Win . opponent . color $ pos)
 
 toForest :: [Ply] -> Forest Ply
 toForest [] = []
@@ -210,3 +216,6 @@
 isScore :: Info -> Bool
 isScore Score{} = True
 isScore _ = False
+
+putLog :: String -> IO ()
+putLog = hPutStrLn stderr
diff --git a/book/twic-9g.bin b/book/twic-9g.bin
# file too large to diff: book/twic-9g.bin
diff --git a/chessIO.cabal b/chessIO.cabal
--- a/chessIO.cabal
+++ b/chessIO.cabal
@@ -4,10 +4,10 @@
 --
 -- see: https://github.com/sol/hpack
 --
--- hash: 42d3baaf01a58ef1a5dea2e87a5e4d8253721c3718f0f1a2ac8678ae0d61d446
+-- hash: 3c2f1e5481309fb4c13b0565acd9d7bb18a1777df7e299c595bac1605cdc1b11
 
 name:           chessIO
-version:        0.4.0.0
+version:        0.5.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
@@ -20,7 +20,8 @@
 license-file:   LICENSE
 build-type:     Simple
 extra-source-files:
-    README.rst
+    README.md
+    CHANGELOG.md
     book/twic-9g.bin
 
 source-repository head
@@ -36,10 +37,13 @@
       Game.Chess.QuadBitboard
       Game.Chess.UCI
   other-modules:
+      Game.Chess.Internal
+      Game.Chess.SAN
+      Game.Chess.Tree
       Paths_chessIO
   hs-source-dirs:
       src
-  default-extensions: BangPatterns BinaryLiterals BlockArguments DeriveGeneric FlexibleContexts GeneralizedNewtypeDeriving LambdaCase MultiParamTypeClasses NamedFieldPuns NumericUnderscores RecordWildCards OverloadedStrings PatternSynonyms TupleSections TypeApplications TypeFamilies ViewPatterns
+  default-extensions: BangPatterns BinaryLiterals BlockArguments DeriveGeneric FlexibleContexts GeneralizedNewtypeDeriving LambdaCase MultiParamTypeClasses MultiWayIf NamedFieldPuns NumericUnderscores RecordWildCards OverloadedStrings PatternSynonyms TupleSections TypeApplications TypeFamilies ViewPatterns
   ghc-options: -Wall -O2
   build-depends:
       MonadRandom
@@ -48,10 +52,10 @@
     , binary
     , bytestring
     , containers
+    , extra
     , file-embed
-    , megaparsec
+    , megaparsec >=9.0
     , o-clock
-    , parser-combinators
     , prettyprinter
     , process
     , random
@@ -67,7 +71,7 @@
       Paths_chessIO
   hs-source-dirs:
       app
-  default-extensions: BangPatterns BinaryLiterals BlockArguments DeriveGeneric FlexibleContexts GeneralizedNewtypeDeriving LambdaCase MultiParamTypeClasses NamedFieldPuns NumericUnderscores RecordWildCards OverloadedStrings PatternSynonyms TupleSections TypeApplications TypeFamilies ViewPatterns
+  default-extensions: BangPatterns BinaryLiterals BlockArguments DeriveGeneric FlexibleContexts GeneralizedNewtypeDeriving LambdaCase MultiParamTypeClasses MultiWayIf NamedFieldPuns NumericUnderscores RecordWildCards OverloadedStrings PatternSynonyms TupleSections TypeApplications TypeFamilies ViewPatterns
   ghc-options: -Wall -O2 -threaded
   build-depends:
       MonadRandom
@@ -80,10 +84,9 @@
     , extra
     , file-embed
     , haskeline
-    , megaparsec
+    , megaparsec >=9.0
     , mtl
     , o-clock
-    , parser-combinators
     , prettyprinter
     , process
     , random
@@ -99,7 +102,7 @@
       Paths_chessIO
   hs-source-dirs:
       app
-  default-extensions: BangPatterns BinaryLiterals BlockArguments DeriveGeneric FlexibleContexts GeneralizedNewtypeDeriving LambdaCase MultiParamTypeClasses NamedFieldPuns NumericUnderscores RecordWildCards OverloadedStrings PatternSynonyms TupleSections TypeApplications TypeFamilies ViewPatterns
+  default-extensions: BangPatterns BinaryLiterals BlockArguments DeriveGeneric FlexibleContexts GeneralizedNewtypeDeriving LambdaCase MultiParamTypeClasses MultiWayIf NamedFieldPuns NumericUnderscores RecordWildCards OverloadedStrings PatternSynonyms TupleSections TypeApplications TypeFamilies ViewPatterns
   ghc-options: -Wall -O2
   build-depends:
       MonadRandom
@@ -109,10 +112,10 @@
     , bytestring
     , chessIO
     , containers
+    , extra
     , file-embed
-    , megaparsec
+    , megaparsec >=9.0
     , o-clock
-    , parser-combinators
     , prettyprinter
     , process
     , random
@@ -128,7 +131,7 @@
       Paths_chessIO
   hs-source-dirs:
       app
-  default-extensions: BangPatterns BinaryLiterals BlockArguments DeriveGeneric FlexibleContexts GeneralizedNewtypeDeriving LambdaCase MultiParamTypeClasses NamedFieldPuns NumericUnderscores RecordWildCards OverloadedStrings PatternSynonyms TupleSections TypeApplications TypeFamilies ViewPatterns
+  default-extensions: BangPatterns BinaryLiterals BlockArguments DeriveGeneric FlexibleContexts GeneralizedNewtypeDeriving LambdaCase MultiParamTypeClasses MultiWayIf NamedFieldPuns NumericUnderscores RecordWildCards OverloadedStrings PatternSynonyms TupleSections TypeApplications TypeFamilies ViewPatterns
   ghc-options: -Wall -O2
   build-depends:
       MonadRandom
@@ -138,11 +141,11 @@
     , bytestring
     , chessIO
     , containers
+    , extra
     , file-embed
-    , megaparsec
+    , megaparsec >=9.0
     , o-clock
     , optparse-applicative
-    , parser-combinators
     , prettyprinter
     , process
     , random
@@ -160,7 +163,7 @@
       Paths_chessIO
   hs-source-dirs:
       test
-  default-extensions: BangPatterns BinaryLiterals BlockArguments DeriveGeneric FlexibleContexts GeneralizedNewtypeDeriving LambdaCase MultiParamTypeClasses NamedFieldPuns NumericUnderscores RecordWildCards OverloadedStrings PatternSynonyms TupleSections TypeApplications TypeFamilies ViewPatterns
+  default-extensions: BangPatterns BinaryLiterals BlockArguments DeriveGeneric FlexibleContexts GeneralizedNewtypeDeriving LambdaCase MultiParamTypeClasses MultiWayIf NamedFieldPuns NumericUnderscores RecordWildCards OverloadedStrings PatternSynonyms TupleSections TypeApplications TypeFamilies ViewPatterns
   ghc-options: -Wall -O2 -threaded -rtsopts "-with-rtsopts=-N -s"
   build-depends:
       MonadRandom
@@ -171,11 +174,11 @@
     , chessIO
     , containers
     , directory
+    , extra
     , file-embed
-    , megaparsec
+    , megaparsec >=9.0
     , o-clock
     , parallel
-    , parser-combinators
     , prettyprinter
     , process
     , random
diff --git a/src/Game/Chess.hs b/src/Game/Chess.hs
--- a/src/Game/Chess.hs
+++ b/src/Game/Chess.hs
@@ -1,4 +1,3 @@
-{-# LANGUAGE PolyKinds, FlexibleInstances, GADTs, ScopedTypeVariables #-}
 {-|
 Module      : Game.Chess
 Description : Basic data types and functions related to the game of chess
@@ -22,6 +21,7 @@
 , PieceType(..), Castle(..)
 , Position, startpos, color, moveNumber, halfMoveClock, pieceAt, inCheck
 , castlingRights, canCastleKingside, canCastleQueenside
+, insufficientMaterial, repetitions
   -- ** Converting from/to Forsyth-Edwards-Notation
 , fromFEN, toFEN
   -- ** Position tree
@@ -29,7 +29,7 @@
   -- * Chess moves
 , Ply(..)
   -- ** Converting from/to algebraic notation
-, strictSAN, relaxedSAN, fromSAN, toSAN, unsafeToSAN, fromUCI, toUCI
+, strictSAN, relaxedSAN, fromSAN, toSAN, unsafeToSAN, varToSAN, fromUCI, toUCI
 , fromPolyglot, toPolyglot
   -- ** Move generation
 , legalPlies
@@ -39,884 +39,6 @@
 , plyTree, plyForest
 ) 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 Game.Chess.QuadBitboard (QuadBitboard)
-import qualified Game.Chess.QuadBitboard as QBB
-import Text.Megaparsec
-import Text.Read (readMaybe)
-import Data.Tree
-
-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)
-
-capturing :: Position -> Ply -> Maybe PieceType
-capturing pos@Position{flags} (unpack -> (_, to, _))
-  | (flags .&. epMask) `testBit` to = Just Pawn
-  | otherwise = snd <$> pieceAt pos to
-
-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
-  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
-
-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"
-
-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 | capture -> fileChar from : target <> promotion
-         | otherwise -> target <> promotion
-    King | color pos == White && m == wKscm -> "O-O"
-         | color pos == White && m == wQscm -> "O-O-O"
-         | color pos == Black && m == bKscm -> "O-O"
-         | color pos == Black && m == bQscm -> "O-O-O"
-         | otherwise -> 'K' : target
-    Knight -> 'N' : source <> target
-    Bishop -> 'B' : source <> target
-    Rook   -> 'R' : source <> target
-    Queen  -> 'Q' : source <> target
-  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                   = toCoord from
-  target
-    | 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 (legalPlies nextPos)
-         = "#"
-         | inCheck (color nextPos) nextPos
-         = "+"
-         | otherwise
-         = ""
-  nextPos = unsafeDoPly pos m
-  ms = filter movesTo $ legalPlies pos
-  movesTo (unpack -> (from', 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) = toRF from
-  fileChar i = chr $ (i `mod` 8) + ord 'a'
-  rankChar i = chr $ (i `div` 8) + ord '1'
-
--- | The starting position as given by the FEN string
---   "rnbqkbnr/pppppppp/8/8/8/8/PPPPPPPP/RNBQKBNR w KQkq - 0 1".
-startpos :: Position
-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, Ix, Ord, Show)
-
-data Color = Black | White deriving (Eq, Ix, Ord, Show)
-
-pieceAt :: IsSquare sq => Position -> sq -> Maybe (Color, PieceType)
-pieceAt Position{qbb} (toIndex -> sq) = case qbb QBB.! sq of
-  QBB.WhitePawn -> Just (White, Pawn)
-  QBB.WhiteKnight -> Just (White, Knight)
-  QBB.WhiteBishop -> Just (White, Bishop)
-  QBB.WhiteRook -> Just (White, Rook)
-  QBB.WhiteQueen -> Just (White, Queen)
-  QBB.WhiteKing -> Just (White, King)
-  QBB.BlackPawn -> Just (Black, Pawn)
-  QBB.BlackKnight -> Just (Black, Knight)
-  QBB.BlackBishop -> Just (Black, Bishop)
-  QBB.BlackRook -> Just (Black, Rook)
-  QBB.BlackQueen -> Just (Black, Queen)
-  QBB.BlackKing -> Just (Black, King)
-  _             -> Nothing
-
-opponent :: Color -> Color
-opponent White = Black
-opponent Black = White
-
-data Piece = Piece !Color !PieceType deriving (Eq, Show)
-
-data Sq = A1 | B1 | C1 | D1 | E1 | F1 | G1 | H1
-        | A2 | B2 | C2 | D2 | E2 | F2 | G2 | H2
-        | A3 | B3 | C3 | D3 | E3 | F3 | G3 | H3
-        | A4 | B4 | C4 | D4 | E4 | F4 | G4 | H4
-        | A5 | B5 | C5 | D5 | E5 | F5 | G5 | H5
-        | 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, Ix, Ord, Show)
-
-class IsSquare sq where
-  toIndex :: sq -> Int
-
-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 Position = Position {
-  qbb :: {-# UNPACK #-} !QuadBitboard
-, color :: !Color
-  -- ^ active color
-, flags :: !Word64
-, halfMoveClock :: !Int
-, moveNumber :: !Int
-  -- ^ number of the full move
-}
-
-instance Eq Position where
-  a == b = qbb a == qbb b && color a == color b && flags a == flags b
-
--- | Construct a position from Forsyth-Edwards-Notation.
-fromFEN :: String -> Maybe Position
-fromFEN fen
-  | length parts /= 6
-  = Nothing
-  | otherwise =
-    Position <$> Just (fromString (parts !! 0))
-             <*> readColor (parts !! 1)
-             <*> readFlags (parts !! 2) (parts !! 3)
-             <*> readMaybe (parts !! 4)
-             <*> readMaybe (parts !! 5)
- where
-  parts = words fen
-  readColor "w" = Just White
-  readColor "b" = Just Black
-  readColor _ = Nothing
-
-  readFlags cst ep = (.|.) <$> readCst cst <*> readEP ep where
-    readCst "-" = Just 0
-    readCst x = go x where
-      go ('K':xs) = (crwKs .|.) <$> go xs
-      go ('Q':xs) = (crwQs .|.) <$> go xs
-      go ('k':xs) = (crbKs .|.) <$> go xs
-      go ('q':xs) = (crbQs .|.) <$> go xs
-      go [] = Just 0
-      go _ = Nothing
-    readEP "-" = Just 0
-    readEP [f,r]
-      | inRange ('a','h') f && (r == '3' || r == '6')
-      = Just $ bit ((ord r - ord '1') * 8 + (ord f - ord 'a'))
-    readEP _ = Nothing
-
--- | Convert a position to Forsyth-Edwards-Notation.
-toFEN :: Position -> String
-toFEN (Position bb c flgs hm mn) = unwords [
-    QBB.toString bb
-  , showColor c, showCst (flgs `clearMask` epMask), showEP (flgs .&. epMask), show hm, show mn
-  ]
- where
-  showColor White = "w"
-  showColor Black = "b"
-  showCst 0 = "-"
-  showCst x = snd . wks . wqs . bks . bqs $ (x, "") where
-    wks (v, xs) | v `testMask` crwKs = (v, 'K':xs)
-                | otherwise          = (v, xs)
-    wqs (v, xs) | v `testMask` crwQs = (v, 'Q':xs)
-                | otherwise          = (v, xs)
-    bks (v, xs) | v `testMask` crbKs = (v, 'k':xs)
-                | otherwise          = (v, xs)
-    bqs (v, xs) | v `testMask` crbQs = (v, 'q':xs)
-                | otherwise          = (v, xs)
-  showEP 0 = "-"
-  showEP x = chr (f + ord 'a') : [chr (r + ord '1')] where
-    (r, f) = toRF $ bitScanForward x
-
-occupiedBy :: Color -> QuadBitboard -> Word64
-occupiedBy White = QBB.white
-occupiedBy Black = QBB.black
-
-occupied :: QuadBitboard -> Word64
-occupied = QBB.occupied
-
-foldBits :: (a -> Int -> a) -> a -> Word64 -> a
-foldBits _ a 0 = a
-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 Ply = Ply Word16 deriving (Eq)
-
-instance Show Ply where
-  show = toUCI
-
-move :: (IsSquare from, IsSquare to) => from -> to -> Ply
-move (toIndex -> from) (toIndex -> to) =
-  Ply $ fromIntegral to .|. fromIntegral from `unsafeShiftL` 6
-
-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 :: 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
-    2 -> Just Bishop
-    3 -> Just Rook
-    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
-
-toPolyglot :: Position -> Ply -> Ply
-toPolyglot pos pl@(unpack -> (from, to, _)) = case color pos of
-  White | from == toIndex E1 && canCastleKingside pos && to == toIndex G1
-          -> from `move` H1
-        | from == toIndex E1 && canCastleQueenside pos && to == toIndex C1
-          -> from `move` A1
-  Black | from == toIndex E8 && canCastleKingside pos && to == toIndex G8
-          -> from `move` H8
-        | from == toIndex E8 && canCastleQueenside pos && to == toIndex C8
-          -> from `move` A8
-  _ -> pl
-
--- | Parse a move in the format used by the Universal Chess Interface protocol.
-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
-  | length from == 2 && length to == 2 && length promo == 1
-  = (\f t p -> move f t `promoteTo` p) <$> readCoord from
-                                       <*> readCoord to
-                                       <*> readPromo promo
-      >>= relativeTo pos
- where
-  readCoord [f,r]
-    | inRange ('a','h') f && inRange ('1','8') r
-    = Just $ (ord r - ord '1') * 8 + (ord f - ord 'a')
-  readCoord _ = Nothing
-  readPromo "q" = Just Queen
-  readPromo "r" = Just Rook
-  readPromo "b" = Just Bishop
-  readPromo "n" = Just Knight
-  readPromo _ = Nothing
-fromUCI _ _ = Nothing
-
--- | Convert a move to the format used by the Universal Chess Interface protocol.
-toUCI :: Ply -> String
-toUCI (unpack -> (from, to, promo)) = coord from <> coord to <> p where
-  coord x = let (r,f) = toRF x in
-            chr (f + ord 'a') : [chr (r + ord '1')]
-  p = case promo of
-    Just Queen -> "q"
-    Just Rook -> "r"
-    Just Bishop -> "b"
-    Just Knight -> "n"
-    _ -> ""
-
--- | Validate that a certain move is legal in the given position.
-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
-shiftN   w = w `unsafeShiftL` 8
-shiftNNE w = w `unsafeShiftL` 17 .&. notAFile
-shiftNE  w = w `unsafeShiftL` 9 .&. notAFile
-shiftENE w = w `unsafeShiftL` 10 .&. notABFile
-shiftE   w = w `unsafeShiftL` 1 .&. notAFile
-shiftESE w = w `unsafeShiftR` 6 .&. notABFile
-shiftSE  w = w `unsafeShiftR` 7 .&. notAFile
-shiftSSE w = w `unsafeShiftR` 15 .&. notAFile
-shiftS   w = w `unsafeShiftR` 8
-shiftSSW w = w `unsafeShiftR` 17 .&. notHFile
-shiftSW  w = w `unsafeShiftR` 9 .&. notHFile
-shiftWSW w = w `unsafeShiftR` 10 .&. notGHFile
-shiftW   w = w `unsafeShiftR` 1 .&. notHFile
-shiftWNW w = w `unsafeShiftL` 6 .&. notGHFile
-shiftNW  w = w `unsafeShiftL` 7 .&. notHFile
-shiftNNW w = w `unsafeShiftL` 15 .&. notHFile
-
--- | 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 '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 '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.
-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{qbb, flags} m@(unpack -> (from, to, promo))
-  | m == wKscm && flags `testMask` crwKs
-  = pos { qbb = qbb <> QBB.whiteKingsideCastle
-        , flags = flags `clearMask` (rank1 .|. epMask)
-        }
-  | m == wQscm && flags `testMask` crwQs
-  = pos { qbb = qbb <> QBB.whiteQueensideCastle
-        , flags = flags `clearMask` (rank1 .|. epMask)
-        }
-  | m == bKscm && flags `testMask` crbKs
-  = pos { qbb = qbb <> QBB.blackKingsideCastle
-        , flags = flags `clearMask` (rank8 .|. epMask)
-        }
-  | m == bQscm && flags `testMask` crbQs
-  = pos { qbb = qbb <> QBB.blackQueensideCastle
-        , flags = flags `clearMask` (rank8 .|. epMask)
-        }
-  | Just piece <- promo
-  = case color pos of
-      White -> case piece of
-        Queen -> pos { qbb = QBB.whitePromotion qbb from to QBB.WhiteQueen
-                     , flags = flags `clearMask` (epMask .|. bit to)
-                     }
-        Rook  -> pos { qbb = QBB.whitePromotion qbb from to QBB.WhiteRook
-                     , flags = flags `clearMask` (epMask .|. bit to)
-                     }
-        Bishop -> pos { qbb = QBB.whitePromotion qbb from to QBB.WhiteBishop
-                      , flags = flags `clearMask` (epMask .|. bit to)
-                      }
-        Knight -> pos { qbb = QBB.whitePromotion qbb from to QBB.WhiteKnight
-                      , flags = flags `clearMask` (epMask .|. bit to)
-                      }
-        _ -> error "Impossible: White tried to promote to Pawn"
-      Black -> case piece of
-        Queen -> pos { qbb = QBB.blackPromotion qbb from to QBB.BlackQueen
-                     , flags = flags `clearMask` (epMask .|. bit to)
-                     }  
-        Rook   -> pos { qbb = QBB.blackPromotion qbb from to QBB.BlackRook
-                      , flags = flags `clearMask` (epMask .|. bit to)
-                      }
-        Bishop -> pos { qbb = QBB.blackPromotion qbb from to QBB.BlackBishop
-                      , flags = flags `clearMask` (epMask .|. bit to)
-                      }
-        Knight -> pos { qbb = QBB.blackPromotion qbb from to QBB.BlackKnight
-                      , flags = flags `clearMask` (epMask .|. bit to)
-                      }
-        _ -> error "Impossible: Black tried to promote to Pawn"
-  | QBB.pawns qbb `testMask` fromMask &&
-    toMask .&. (rank3 .|. rank6) .&. flags /= 0
-  = pos { qbb = qbb <> QBB.enPassant from to
-        , flags = flags `clearMask` toMask
-        }
-  | otherwise
-  = pos { qbb = QBB.move qbb from to
-        , flags = (flags `clearMask` (epMask .|. mask)) .|. dpp
-        }
- where
-  !fromMask = 1 `unsafeShiftL` from
-  !toMask = 1 `unsafeShiftL` to
-  !mask = fromMask .|. toMask
-  dpp = case color pos of
-    White | fromMask .&. rank2 .&. QBB.wPawns qbb /= 0 && from + 16 == to -> shiftN fromMask
-    Black | fromMask .&. rank7 .&. QBB.bPawns qbb /= 0 && from - 16 == to -> shiftS fromMask
-    _                                                            -> 0
-
--- | Generate a list of possible moves for the given position.
-legalPlies :: Position -> [Ply]
-legalPlies pos@Position{color, qbb, flags} = filter legalPly $
-      kingMoves
-    . knightMoves
-    . slideMoves Queen pos notOurs occ
-    . slideMoves Rook pos notOurs occ
-    . slideMoves Bishop pos notOurs occ
-    . pawnMoves
-    $ []
- where
-  legalPly = not . inCheck color . unsafeDoPly' pos
-  !ours = occupiedBy color qbb
-  !them = occupiedBy (opponent color) qbb
-  !notOurs = complement ours
-  !occ = ours .|. them
-  (!pawnMoves, !knightMoves, !kingMoves) = case color of
-    White ->
-      ( wPawnMoves (QBB.wPawns qbb) (complement occ) (them .|. (flags .&. epMask))
-      , flip (foldBits genNMoves) (QBB.wKnights qbb)
-      , flip (foldBits genKMoves) (QBB.wKings qbb) . wShort . wLong)
-    Black ->
-      ( bPawnMoves (QBB.bPawns qbb) (complement occ) (them .|. (flags .&. epMask))
-      , flip (foldBits genNMoves) (QBB.bKnights qbb)
-      , flip (foldBits genKMoves) (QBB.bKings qbb) . bShort . bLong)
-  genNMoves ms sq = foldBits (mkM sq) ms ((knightAttacks ! sq) .&. notOurs)
-  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{qbb} =
-  attackedBy Black qbb (occupied qbb) (bitScanForward (QBB.wKings qbb))
-inCheck Black Position{qbb} =
-  attackedBy White qbb (occupied qbb) (bitScanForward (QBB.bKings qbb))
-
-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
-  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 -> [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
-  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 -> [Ply] -> [Ply]
-slideMoves piece (Position bb c _ _ _) !notOurs !occ =
-  flip (foldBits gen) pieces
- where
-  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"
-  pieces = case (c, piece) of
-    (White, Bishop) -> QBB.wBishops bb
-    (Black, Bishop) -> QBB.bBishops bb
-    (White, Rook)   -> QBB.wRooks bb
-    (Black, Rook)   -> QBB.bRooks bb
-    (White, Queen)  -> QBB.wQueens bb
-    (Black, Queen)  -> QBB.bQueens bb
-    _ -> 0
-
-data Castle = Kingside | Queenside deriving (Eq, Ix, Ord, Show)
-
-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
-
-canCastleKingside, canCastleQueenside :: Position -> Bool
-canCastleKingside pos@Position{qbb} = canCastleKingside' pos (occupied qbb)
-canCastleQueenside pos@Position{qbb} = canCastleQueenside' pos (occupied qbb)
-
-canCastleKingside', canCastleQueenside' :: Position -> Word64 -> Bool
-canCastleKingside' Position{qbb, color = White, flags} !occ =
-  flags `testMask` crwKs && occ .&. crwKe == 0 &&
-  not (any (attackedBy Black qbb occ) [E1, F1, G1])
-canCastleKingside' Position{qbb, color = Black, flags} !occ = 
-  flags `testMask` crbKs && occ .&. crbKe == 0 &&
-  not (any (attackedBy White qbb occ) [E8, F8, G8])
-canCastleQueenside' Position{qbb, color = White, flags} !occ =
-  flags `testMask` crwQs && occ .&. crwQe == 0 &&
-  not (any (attackedBy Black qbb occ) [E1, D1, C1])
-canCastleQueenside' Position{qbb, color = Black, flags} !occ =
-  flags `testMask` crbQs && occ .&. crbQe == 0 &&
-  not (any (attackedBy White qbb 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 -> QuadBitboard -> Word64 -> sq -> Bool
-attackedBy White qbb !occ (toIndex -> sq)
-  | (wPawnAttacks ! sq) .&. QBB.wPawns qbb /= 0 = True
-  | (knightAttacks ! sq) .&. QBB.wKnights qbb /= 0 = True
-  | bishopTargets sq occ .&. QBB.wBishops qbb /= 0 = True
-  | rookTargets sq occ .&.   QBB.wRooks qbb /= 0 = True
-  | queenTargets sq occ .&. QBB.wQueens qbb /= 0 = True
-  | (kingAttacks ! sq) .&. QBB.wKings qbb /= 0   = True
-  | otherwise                        = False
-attackedBy Black qbb !occ (toIndex -> sq)
-  | (bPawnAttacks ! sq) .&. QBB.bPawns qbb /= 0 = True
-  | (knightAttacks ! sq) .&. QBB.bKnights qbb /= 0 = True
-  | bishopTargets sq occ .&. QBB.bBishops qbb /= 0 = True
-  | rookTargets sq occ .&.   QBB.bRooks qbb /= 0 = True
-  | queenTargets sq occ .&.  QBB.bQueens qbb /= 0 = True
-  | (kingAttacks ! sq) .&. QBB.bKings qbb /= 0   = True
-  | otherwise                        = False
-
-notAFile, notABFile, notGHFile, notHFile, rank1, rank2, rank3, rank4, rank5, rank6, rank7, rank8 :: Word64
-notAFile = 0xfefefefefefefefe
-notABFile = 0xfcfcfcfcfcfcfcfc
-notGHFile = 0x3f3f3f3f3f3f3f3f
-notHFile = 0x7f7f7f7f7f7f7f7f
-rank1 = 0x00000000000000ff
-rank2 = 0x000000000000ff00
-rank3 = 0x0000000000ff0000
-rank4 = 0x00000000ff000000
-rank5 = 0x000000ff00000000
-rank6 = 0x0000ff0000000000
-rank7 = 0x00ff000000000000
-rank8 = 0xff00000000000000
-
-epMask, crwKs, crwQs, crwKe, crwQe, crbKs, crbQs, crbKe, crbQe :: Word64
-epMask = rank3 .|. rank6        -- mask for en passant
-crwKs  = 0x0000000000000090     -- white: king & rook position for kingside castle
-crwQs  = 0x0000000000000011     -- white: king & rook pisition for queenside castle^M
-crwKe  = 0x0000000000000060     -- white: empty fields for kingside castle
-crwQe  = 0x000000000000000e     -- white: empty fields for queenside castle
-crbKs  = 0x9000000000000000     -- black: king & rook position for kingside castle
-crbQs  = 0x1100000000000000     -- black: king & rook position for queenside castle^M
-crbKe  = 0x6000000000000000     -- black: empty fields for kingside castle
-crbQe  = 0x0e00000000000000     -- black: empty fields for queenside castle
-
-kingAttacks, knightAttacks, wPawnAttacks, bPawnAttacks :: Vector Word64
-kingAttacks = Vector.generate 64 $ \sq -> let b = bit sq in
-  shiftN b .|. shiftNE b .|. shiftE b .|. shiftSE b .|.
-  shiftS b .|. shiftSW b .|. shiftW b .|. shiftNW b
-knightAttacks = Vector.generate 64 $ \sq -> let b = bit sq in
-  shiftNNE b .|. shiftENE b .|.
-  shiftESE b .|. shiftSSE b .|.
-  shiftSSW b .|. shiftWSW b .|.
-  shiftWNW b .|. shiftNNW b
-wPawnAttacks = Vector.generate 64 $ \sq -> let b = bit sq in
-  shiftSE b .|. shiftSW b
-bPawnAttacks = Vector.generate 64 $ \sq -> let b = bit sq in
-  shiftNE b .|. shiftNW b
-
-data Direction = N | NE | E | SE | S | SW | W | NW deriving (Eq, Show)
-
-rookTargets, bishopTargets, queenTargets :: Int -> Word64 -> Word64
-rookTargets !sq !occ = getRayTargets sq N occ .|. getRayTargets sq E occ
-                   .|. getRayTargets sq S occ .|. getRayTargets sq W occ
-bishopTargets !sq !occ = getRayTargets sq NW occ .|. getRayTargets sq NE occ
-                     .|. getRayTargets sq SE occ .|. getRayTargets sq SW occ
-queenTargets sq occ = rookTargets sq occ .|. bishopTargets sq occ
-
-getRayTargets :: Int -> Direction -> Word64 -> Word64
-getRayTargets sq dir occ = blocked $ attacks .&. occ where
-  blocked 0 = attacks
-  blocked bb = attacks `xor` (ray ! bitScan bb)
-  attacks = ray ! sq
-  (bitScan, ray) = case dir of
-    NW -> (bitScanForward, attackNW)
-    N  -> (bitScanForward, attackN)
-    NE -> (bitScanForward, attackNE)
-    E  -> (bitScanForward, attackE)
-    SE -> (bitScanReverse, attackSE)
-    S  -> (bitScanReverse, attackS)
-    SW -> (bitScanReverse, attackSW)
-    W  -> (bitScanReverse, attackW)
-
-attackDir :: (Word64 -> Word64) -> Vector Word64
-attackDir s = Vector.generate 64 $ \sq ->
-  foldr (.|.) 0 $ take 7 $ tail $ iterate s (bit sq)
-
-attackNW, attackN, attackNE, attackE, attackSE, attackS, attackSW, attackW :: Vector Word64
-attackNW = attackDir shiftNW
-attackN  = attackDir shiftN
-attackNE = attackDir shiftNE
-attackE  = attackDir shiftE
-attackSE = attackDir shiftSE
-attackS  = attackDir shiftS
-attackSW = attackDir shiftSW
-attackW  = attackDir shiftW
-
-clearMask :: Bits a => a -> a -> a
-clearMask a b = a .&. complement b
-
-testMask :: Bits a => a -> a -> Bool
-testMask a b = a .&. b == b
-
-{-# INLINE clearMask #-}
-{-# INLINE testMask #-}
-{-# INLINE attackedBy #-}
-{-# INLINE slideMoves #-}
-{-# INLINE wPawnMoves #-}
-{-# INLINE bPawnMoves #-}
-{-# INLINE unpack #-}
-{-# INLINE foldBits #-}
-{-# INLINE bitScanForward #-}
-{-# INLINE bitScanReverse #-}
-{-# 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 #-}
+import Game.Chess.Internal
+import Game.Chess.SAN
+import Game.Chess.Tree
diff --git a/src/Game/Chess/Internal.hs b/src/Game/Chess/Internal.hs
new file mode 100644
--- /dev/null
+++ b/src/Game/Chess/Internal.hs
@@ -0,0 +1,658 @@
+{-|
+Module      : Game.Chess
+Description : Basic data types and functions related to the game of chess
+Copyright   : (c) Mario Lang, 2020
+License     : BSD3
+Maintainer  : mlang@blind.guru
+Stability   : experimental
+
+A small collection of data types and functions to represent Chess positions
+and moves including move generation and parsing from external sources.
+
+This module does deliberately not implement
+any search or evaluation functionality.  It is intended to be used
+to lay the ground for communicating with other programs or players, hence the
+package name chessIO.
+-}
+module Game.Chess.Internal where
+
+import Data.Bits
+  ( Bits((.&.), testBit, unsafeShiftR, unsafeShiftL, xor, (.|.), bit, complement),
+    FiniteBits(countLeadingZeros, countTrailingZeros) )
+import Data.Char ( ord, chr )
+import Data.Ix ( Ix(inRange) )
+import Data.List (nub, sortOn)
+import Data.Maybe ( fromJust, isJust, listToMaybe )
+import Data.Ord (Down(..))
+import Data.String ( IsString(..) )
+import Data.Vector.Unboxed (Vector, (!))
+import qualified Data.Vector.Unboxed as Vector
+import Data.Word ( Word16, Word64 )
+import Foreign.Storable
+import Game.Chess.QuadBitboard (QuadBitboard)
+import qualified Game.Chess.QuadBitboard as QBB
+import Text.Read (readMaybe)
+
+capturing :: Position -> Ply -> Maybe PieceType
+capturing pos@Position{flags} (unpack -> (_, to, _))
+  | (flags .&. epMask) `testBit` to = Just Pawn
+  | otherwise = snd <$> pieceAt pos to
+
+isCapture :: Position -> Ply -> Bool
+isCapture pos = isJust . capturing pos
+
+-- | The starting position as given by the FEN string
+--   "rnbqkbnr/pppppppp/8/8/8/8/PPPPPPPP/RNBQKBNR w KQkq - 0 1".
+startpos :: Position
+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, Ix, Ord, Show)
+
+data Color = Black | White deriving (Eq, Ix, Ord, Show)
+
+pieceAt :: IsSquare sq => Position -> sq -> Maybe (Color, PieceType)
+pieceAt Position{qbb} (toIndex -> sq) = case qbb QBB.! sq of
+  QBB.WhitePawn -> Just (White, Pawn)
+  QBB.WhiteKnight -> Just (White, Knight)
+  QBB.WhiteBishop -> Just (White, Bishop)
+  QBB.WhiteRook -> Just (White, Rook)
+  QBB.WhiteQueen -> Just (White, Queen)
+  QBB.WhiteKing -> Just (White, King)
+  QBB.BlackPawn -> Just (Black, Pawn)
+  QBB.BlackKnight -> Just (Black, Knight)
+  QBB.BlackBishop -> Just (Black, Bishop)
+  QBB.BlackRook -> Just (Black, Rook)
+  QBB.BlackQueen -> Just (Black, Queen)
+  QBB.BlackKing -> Just (Black, King)
+  _             -> Nothing
+
+opponent :: Color -> Color
+opponent White = Black
+opponent Black = White
+
+data Piece = Piece !Color !PieceType deriving (Eq, Show)
+
+data Sq = A1 | B1 | C1 | D1 | E1 | F1 | G1 | H1
+        | A2 | B2 | C2 | D2 | E2 | F2 | G2 | H2
+        | A3 | B3 | C3 | D3 | E3 | F3 | G3 | H3
+        | A4 | B4 | C4 | D4 | E4 | F4 | G4 | H4
+        | A5 | B5 | C5 | D5 | E5 | F5 | G5 | H5
+        | 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, Ix, Ord, Show)
+
+class IsSquare sq where
+  toIndex :: sq -> Int
+
+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 Position = Position {
+  qbb :: {-# UNPACK #-} !QuadBitboard
+, color :: !Color
+  -- ^ active color
+, flags :: !Word64
+, halfMoveClock :: !Int
+, moveNumber :: !Int
+  -- ^ number of the full move
+}
+
+-- Article 9.2 states that a position is considered
+-- identical to another if the same player is on move, the same types of
+-- pieces of the same colors occupy the same squares, and the same moves
+-- are available to each player; in particular, each player has the same
+-- castling and en passant capturing rights.
+instance Eq Position where
+  a == b = qbb a == qbb b && color a == color b && flags a == flags b
+
+repetitions :: [Position] -> Maybe (Int, Position)
+repetitions p = listToMaybe . sortOn (Down . fst) $ fmap f (nub p) where
+  f x = (count x p, x)
+  count x = length . filter (== x)
+
+instance Show Position where
+  show p = '"' : toFEN p <> ['"']
+
+insufficientMaterial :: Position -> Bool
+insufficientMaterial Position{qbb} = QBB.insufficientMaterial qbb
+
+-- | Construct a position from Forsyth-Edwards-Notation.
+fromFEN :: String -> Maybe Position
+fromFEN fen
+  | length parts /= 6
+  = Nothing
+  | otherwise =
+    Position <$> Just (fromString (parts !! 0))
+             <*> readColor (parts !! 1)
+             <*> readFlags (parts !! 2) (parts !! 3)
+             <*> readMaybe (parts !! 4)
+             <*> readMaybe (parts !! 5)
+ where
+  parts = words fen
+  readColor "w" = Just White
+  readColor "b" = Just Black
+  readColor _ = Nothing
+
+  readFlags cst ep = (.|.) <$> readCst cst <*> readEP ep where
+    readCst "-" = Just 0
+    readCst x = go x where
+      go ('K':xs) = (crwKs .|.) <$> go xs
+      go ('Q':xs) = (crwQs .|.) <$> go xs
+      go ('k':xs) = (crbKs .|.) <$> go xs
+      go ('q':xs) = (crbQs .|.) <$> go xs
+      go [] = Just 0
+      go _ = Nothing
+    readEP "-" = Just 0
+    readEP [f,r]
+      | inRange ('a','h') f && (r == '3' || r == '6')
+      = Just $ bit ((ord r - ord '1') * 8 + (ord f - ord 'a'))
+    readEP _ = Nothing
+
+-- | Convert a position to Forsyth-Edwards-Notation.
+toFEN :: Position -> String
+toFEN (Position bb c flgs hm mn) = unwords [
+    QBB.toString bb
+  , showColor c, showCst (flgs `clearMask` epMask), showEP (flgs .&. epMask), show hm, show mn
+  ]
+ where
+  showColor White = "w"
+  showColor Black = "b"
+  showCst 0 = "-"
+  showCst x = snd . wks . wqs . bks . bqs $ (x, "") where
+    wks (v, xs) | v `testMask` crwKs = (v, 'K':xs)
+                | otherwise          = (v, xs)
+    wqs (v, xs) | v `testMask` crwQs = (v, 'Q':xs)
+                | otherwise          = (v, xs)
+    bks (v, xs) | v `testMask` crbKs = (v, 'k':xs)
+                | otherwise          = (v, xs)
+    bqs (v, xs) | v `testMask` crbQs = (v, 'q':xs)
+                | otherwise          = (v, xs)
+  showEP 0 = "-"
+  showEP x = chr (f + ord 'a') : [chr (r + ord '1')] where
+    (r, f) = toRF $ bitScanForward x
+
+occupiedBy :: Color -> QuadBitboard -> Word64
+occupiedBy White = QBB.white
+occupiedBy Black = QBB.black
+
+occupied :: QuadBitboard -> Word64
+occupied = QBB.occupied
+
+foldBits :: (a -> Int -> a) -> a -> Word64 -> a
+foldBits _ a 0 = a
+foldBits f !a n = foldBits f (f a $ countTrailingZeros n) $ n .&. pred n
+
+bitScanForward, bitScanReverse :: Word64 -> Int
+bitScanForward = countTrailingZeros
+bitScanReverse = (63 -) . countLeadingZeros
+
+newtype Ply = Ply Word16 deriving (Eq, Storable)
+
+instance Show Ply where
+  show = toUCI
+
+move :: (IsSquare from, IsSquare to) => from -> to -> Ply
+move (toIndex -> from) (toIndex -> to) =
+  Ply $ fromIntegral to .|. fromIntegral from `unsafeShiftL` 6
+
+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 :: 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
+    2 -> Just Bishop
+    3 -> Just Rook
+    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
+        -> wKscm
+        | from == toIndex E1
+        , canCastleQueenside pos
+        , to == toIndex A1
+        -> wQscm
+  Black | from == toIndex E8
+        , canCastleKingside pos
+        , to == toIndex H8
+        -> bKscm
+        | from == toIndex E8
+        , canCastleQueenside pos
+        , to == toIndex A8
+        -> bQscm
+  _ -> pl
+
+toPolyglot :: Position -> Ply -> Ply
+toPolyglot pos pl@(unpack -> (from, to, _)) = case color pos of
+  White | from == toIndex E1
+        , canCastleKingside pos
+        , to == toIndex G1
+        -> from `move` H1
+        | from == toIndex E1
+        , canCastleQueenside pos
+        , to == toIndex C1
+        -> from `move` A1
+  Black | from == toIndex E8
+        , canCastleKingside pos
+        , to == toIndex G8
+        -> from `move` H8
+        | from == toIndex E8
+        , canCastleQueenside pos
+        , to == toIndex C8
+        -> from `move` A8
+  _ -> pl
+
+-- | Parse a move in the format used by the Universal Chess Interface protocol.
+fromUCI :: Position -> String -> Maybe Ply
+fromUCI pos (fmap (splitAt 2) . splitAt 2 -> (from, (to, promo)))
+  | null promo
+  = move <$> readCoord from <*> readCoord to >>= relativeTo pos
+  | otherwise
+  = (\f t p -> move f t `promoteTo` p) <$> readCoord from
+                                       <*> readCoord to
+                                       <*> readPromo promo
+      >>= relativeTo pos
+ where
+  readCoord [f,r]
+    | inRange ('a','h') f && inRange ('1','8') r
+    = Just $ (ord r - ord '1') * 8 + (ord f - ord 'a')
+  readCoord _ = Nothing
+  readPromo "q" = Just Queen
+  readPromo "r" = Just Rook
+  readPromo "b" = Just Bishop
+  readPromo "n" = Just Knight
+  readPromo _ = Nothing
+
+-- | Convert a move to the format used by the Universal Chess Interface protocol.
+toUCI :: Ply -> String
+toUCI (unpack -> (from, to, promo)) = coord from <> coord to <> p where
+  coord x = let (r,f) = toRF x in
+            chr (f + ord 'a') : [chr (r + ord '1')]
+  p = case promo of
+    Just Queen -> "q"
+    Just Rook -> "r"
+    Just Bishop -> "b"
+    Just Knight -> "n"
+    _ -> ""
+
+-- | Validate that a certain move is legal in the given position.
+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
+shiftN   w = w `unsafeShiftL` 8
+shiftNNE w = w `unsafeShiftL` 17 .&. notAFile
+shiftNE  w = w `unsafeShiftL` 9 .&. notAFile
+shiftENE w = w `unsafeShiftL` 10 .&. notABFile
+shiftE   w = w `unsafeShiftL` 1 .&. notAFile
+shiftESE w = w `unsafeShiftR` 6 .&. notABFile
+shiftSE  w = w `unsafeShiftR` 7 .&. notAFile
+shiftSSE w = w `unsafeShiftR` 15 .&. notAFile
+shiftS   w = w `unsafeShiftR` 8
+shiftSSW w = w `unsafeShiftR` 17 .&. notHFile
+shiftSW  w = w `unsafeShiftR` 9 .&. notHFile
+shiftWSW w = w `unsafeShiftR` 10 .&. notGHFile
+shiftW   w = w `unsafeShiftR` 1 .&. notHFile
+shiftWNW w = w `unsafeShiftL` 6 .&. notGHFile
+shiftNW  w = w `unsafeShiftL` 7 .&. notHFile
+shiftNNW w = w `unsafeShiftL` 15 .&. notHFile
+
+-- | 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 '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 '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.
+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{qbb, flags} m@(unpack -> (from, to, promo))
+  | m == wKscm && flags `testMask` crwKs
+  = pos { qbb = qbb <> QBB.whiteKingsideCastle
+        , flags = flags `clearMask` (rank1 .|. epMask)
+        }
+  | m == wQscm && flags `testMask` crwQs
+  = pos { qbb = qbb <> QBB.whiteQueensideCastle
+        , flags = flags `clearMask` (rank1 .|. epMask)
+        }
+  | m == bKscm && flags `testMask` crbKs
+  = pos { qbb = qbb <> QBB.blackKingsideCastle
+        , flags = flags `clearMask` (rank8 .|. epMask)
+        }
+  | m == bQscm && flags `testMask` crbQs
+  = pos { qbb = qbb <> QBB.blackQueensideCastle
+        , flags = flags `clearMask` (rank8 .|. epMask)
+        }
+  | Just piece <- promo
+  = case color pos of
+      White -> case piece of
+        Queen -> pos { qbb = QBB.whitePromotion qbb from to QBB.WhiteQueen
+                     , flags = flags `clearMask` (epMask .|. bit to)
+                     }
+        Rook  -> pos { qbb = QBB.whitePromotion qbb from to QBB.WhiteRook
+                     , flags = flags `clearMask` (epMask .|. bit to)
+                     }
+        Bishop -> pos { qbb = QBB.whitePromotion qbb from to QBB.WhiteBishop
+                      , flags = flags `clearMask` (epMask .|. bit to)
+                      }
+        Knight -> pos { qbb = QBB.whitePromotion qbb from to QBB.WhiteKnight
+                      , flags = flags `clearMask` (epMask .|. bit to)
+                      }
+        _ -> error "Impossible: White tried to promote to Pawn"
+      Black -> case piece of
+        Queen -> pos { qbb = QBB.blackPromotion qbb from to QBB.BlackQueen
+                     , flags = flags `clearMask` (epMask .|. bit to)
+                     }  
+        Rook   -> pos { qbb = QBB.blackPromotion qbb from to QBB.BlackRook
+                      , flags = flags `clearMask` (epMask .|. bit to)
+                      }
+        Bishop -> pos { qbb = QBB.blackPromotion qbb from to QBB.BlackBishop
+                      , flags = flags `clearMask` (epMask .|. bit to)
+                      }
+        Knight -> pos { qbb = QBB.blackPromotion qbb from to QBB.BlackKnight
+                      , flags = flags `clearMask` (epMask .|. bit to)
+                      }
+        _ -> error "Impossible: Black tried to promote to Pawn"
+  | QBB.pawns qbb `testMask` fromMask &&
+    toMask .&. (rank3 .|. rank6) .&. flags /= 0
+  = pos { qbb = qbb <> QBB.enPassant from to
+        , flags = flags `clearMask` toMask
+        }
+  | otherwise
+  = pos { qbb = QBB.move qbb from to
+        , flags = (flags `clearMask` (epMask .|. mask)) .|. dpp
+        }
+ where
+  !fromMask = 1 `unsafeShiftL` from
+  !toMask = 1 `unsafeShiftL` to
+  !mask = fromMask .|. toMask
+  dpp = case color pos of
+    White | fromMask .&. rank2 .&. QBB.wPawns qbb /= 0 && from + 16 == to -> shiftN fromMask
+    Black | fromMask .&. rank7 .&. QBB.bPawns qbb /= 0 && from - 16 == to -> shiftS fromMask
+    _                                                            -> 0
+
+-- | Generate a list of possible moves for the given position.
+legalPlies :: Position -> [Ply]
+legalPlies pos@Position{color, qbb, flags} = filter legalPly $
+      kingMoves
+    . knightMoves
+    . slideMoves Queen pos notOurs occ
+    . slideMoves Rook pos notOurs occ
+    . slideMoves Bishop pos notOurs occ
+    . pawnMoves
+    $ []
+ where
+  legalPly = not . inCheck color . unsafeDoPly' pos
+  !ours = occupiedBy color qbb
+  !them = occupiedBy (opponent color) qbb
+  !notOurs = complement ours
+  !occ = ours .|. them
+  (!pawnMoves, !knightMoves, !kingMoves) = case color of
+    White ->
+      ( wPawnMoves (QBB.wPawns qbb) (complement occ) (them .|. (flags .&. epMask))
+      , flip (foldBits genNMoves) (QBB.wKnights qbb)
+      , flip (foldBits genKMoves) (QBB.wKings qbb) . wShort . wLong)
+    Black ->
+      ( bPawnMoves (QBB.bPawns qbb) (complement occ) (them .|. (flags .&. epMask))
+      , flip (foldBits genNMoves) (QBB.bKnights qbb)
+      , flip (foldBits genKMoves) (QBB.bKings qbb) . bShort . bLong)
+  genNMoves ms sq = foldBits (mkM sq) ms ((knightAttacks ! sq) .&. notOurs)
+  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{qbb} =
+  attackedBy Black qbb (occupied qbb) (bitScanForward (QBB.wKings qbb))
+inCheck Black Position{qbb} =
+  attackedBy White qbb (occupied qbb) (bitScanForward (QBB.bKings qbb))
+
+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
+  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 -> [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
+  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 -> [Ply] -> [Ply]
+slideMoves piece (Position bb c _ _ _) !notOurs !occ =
+  flip (foldBits gen) pieces
+ where
+  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"
+  pieces = case (c, piece) of
+    (White, Bishop) -> QBB.wBishops bb
+    (Black, Bishop) -> QBB.bBishops bb
+    (White, Rook)   -> QBB.wRooks bb
+    (Black, Rook)   -> QBB.bRooks bb
+    (White, Queen)  -> QBB.wQueens bb
+    (Black, Queen)  -> QBB.bQueens bb
+    _ -> 0
+
+data Castle = Kingside | Queenside deriving (Eq, Ix, Ord, Show)
+
+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
+
+canCastleKingside, canCastleQueenside :: Position -> Bool
+canCastleKingside pos@Position{qbb} = canCastleKingside' pos (occupied qbb)
+canCastleQueenside pos@Position{qbb} = canCastleQueenside' pos (occupied qbb)
+
+canCastleKingside', canCastleQueenside' :: Position -> Word64 -> Bool
+canCastleKingside' Position{qbb, color = White, flags} !occ =
+  flags `testMask` crwKs && occ .&. crwKe == 0 &&
+  not (any (attackedBy Black qbb occ) [E1, F1, G1])
+canCastleKingside' Position{qbb, color = Black, flags} !occ = 
+  flags `testMask` crbKs && occ .&. crbKe == 0 &&
+  not (any (attackedBy White qbb occ) [E8, F8, G8])
+canCastleQueenside' Position{qbb, color = White, flags} !occ =
+  flags `testMask` crwQs && occ .&. crwQe == 0 &&
+  not (any (attackedBy Black qbb occ) [E1, D1, C1])
+canCastleQueenside' Position{qbb, color = Black, flags} !occ =
+  flags `testMask` crbQs && occ .&. crbQe == 0 &&
+  not (any (attackedBy White qbb 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 -> QuadBitboard -> Word64 -> sq -> Bool
+attackedBy White qbb !occ (toIndex -> sq)
+  | (wPawnAttacks ! sq) .&. QBB.wPawns qbb /= 0 = True
+  | (knightAttacks ! sq) .&. QBB.wKnights qbb /= 0 = True
+  | bishopTargets sq occ .&. QBB.wBishops qbb /= 0 = True
+  | rookTargets sq occ .&.   QBB.wRooks qbb /= 0 = True
+  | queenTargets sq occ .&. QBB.wQueens qbb /= 0 = True
+  | (kingAttacks ! sq) .&. QBB.wKings qbb /= 0   = True
+  | otherwise                        = False
+attackedBy Black qbb !occ (toIndex -> sq)
+  | (bPawnAttacks ! sq) .&. QBB.bPawns qbb /= 0 = True
+  | (knightAttacks ! sq) .&. QBB.bKnights qbb /= 0 = True
+  | bishopTargets sq occ .&. QBB.bBishops qbb /= 0 = True
+  | rookTargets sq occ .&.   QBB.bRooks qbb /= 0 = True
+  | queenTargets sq occ .&.  QBB.bQueens qbb /= 0 = True
+  | (kingAttacks ! sq) .&. QBB.bKings qbb /= 0   = True
+  | otherwise                        = False
+
+notAFile, notABFile, notGHFile, notHFile, rank1, rank2, rank3, rank4, rank5, rank6, rank7, rank8 :: Word64
+notAFile = 0xfefefefefefefefe
+notABFile = 0xfcfcfcfcfcfcfcfc
+notGHFile = 0x3f3f3f3f3f3f3f3f
+notHFile = 0x7f7f7f7f7f7f7f7f
+rank1 = 0x00000000000000ff
+rank2 = 0x000000000000ff00
+rank3 = 0x0000000000ff0000
+rank4 = 0x00000000ff000000
+rank5 = 0x000000ff00000000
+rank6 = 0x0000ff0000000000
+rank7 = 0x00ff000000000000
+rank8 = 0xff00000000000000
+
+epMask, crwKs, crwQs, crwKe, crwQe, crbKs, crbQs, crbKe, crbQe :: Word64
+epMask = rank3 .|. rank6        -- mask for en passant
+crwKs  = 0x0000000000000090     -- white: king & rook position for kingside castle
+crwQs  = 0x0000000000000011     -- white: king & rook pisition for queenside castle^M
+crwKe  = 0x0000000000000060     -- white: empty fields for kingside castle
+crwQe  = 0x000000000000000e     -- white: empty fields for queenside castle
+crbKs  = 0x9000000000000000     -- black: king & rook position for kingside castle
+crbQs  = 0x1100000000000000     -- black: king & rook position for queenside castle^M
+crbKe  = 0x6000000000000000     -- black: empty fields for kingside castle
+crbQe  = 0x0e00000000000000     -- black: empty fields for queenside castle
+
+kingAttacks, knightAttacks, wPawnAttacks, bPawnAttacks :: Vector Word64
+kingAttacks = Vector.generate 64 $ \sq -> let b = bit sq in
+  shiftN b .|. shiftNE b .|. shiftE b .|. shiftSE b .|.
+  shiftS b .|. shiftSW b .|. shiftW b .|. shiftNW b
+knightAttacks = Vector.generate 64 $ \sq -> let b = bit sq in
+  shiftNNE b .|. shiftENE b .|.
+  shiftESE b .|. shiftSSE b .|.
+  shiftSSW b .|. shiftWSW b .|.
+  shiftWNW b .|. shiftNNW b
+wPawnAttacks = Vector.generate 64 $ \sq -> let b = bit sq in
+  shiftSE b .|. shiftSW b
+bPawnAttacks = Vector.generate 64 $ \sq -> let b = bit sq in
+  shiftNE b .|. shiftNW b
+
+data Direction = N | NE | E | SE | S | SW | W | NW deriving (Eq, Show)
+
+rookTargets, bishopTargets, queenTargets :: Int -> Word64 -> Word64
+rookTargets !sq !occ = getRayTargets sq N occ .|. getRayTargets sq E occ
+                   .|. getRayTargets sq S occ .|. getRayTargets sq W occ
+bishopTargets !sq !occ = getRayTargets sq NW occ .|. getRayTargets sq NE occ
+                     .|. getRayTargets sq SE occ .|. getRayTargets sq SW occ
+queenTargets sq occ = rookTargets sq occ .|. bishopTargets sq occ
+
+getRayTargets :: Int -> Direction -> Word64 -> Word64
+getRayTargets sq dir occ = blocked $ attacks .&. occ where
+  blocked 0 = attacks
+  blocked bb = attacks `xor` (ray ! bitScan bb)
+  attacks = ray ! sq
+  (bitScan, ray) = case dir of
+    NW -> (bitScanForward, attackNW)
+    N  -> (bitScanForward, attackN)
+    NE -> (bitScanForward, attackNE)
+    E  -> (bitScanForward, attackE)
+    SE -> (bitScanReverse, attackSE)
+    S  -> (bitScanReverse, attackS)
+    SW -> (bitScanReverse, attackSW)
+    W  -> (bitScanReverse, attackW)
+
+attackDir :: (Word64 -> Word64) -> Vector Word64
+attackDir s = Vector.generate 64 $ \sq ->
+  foldr (.|.) 0 $ take 7 $ tail $ iterate s (bit sq)
+
+attackNW, attackN, attackNE, attackE, attackSE, attackS, attackSW, attackW :: Vector Word64
+attackNW = attackDir shiftNW
+attackN  = attackDir shiftN
+attackNE = attackDir shiftNE
+attackE  = attackDir shiftE
+attackSE = attackDir shiftSE
+attackS  = attackDir shiftS
+attackSW = attackDir shiftSW
+attackW  = attackDir shiftW
+
+clearMask :: Bits a => a -> a -> a
+clearMask a b = a .&. complement b
+
+testMask :: Bits a => a -> a -> Bool
+testMask a b = a .&. b == b
+
+{-# INLINE clearMask #-}
+{-# INLINE testMask #-}
+{-# INLINE attackedBy #-}
+{-# INLINE slideMoves #-}
+{-# INLINE wPawnMoves #-}
+{-# INLINE bPawnMoves #-}
+{-# INLINE unpack #-}
+{-# INLINE foldBits #-}
+{-# INLINE bitScanForward #-}
+{-# INLINE bitScanReverse #-}
diff --git a/src/Game/Chess/PGN.hs b/src/Game/Chess/PGN.hs
--- a/src/Game/Chess/PGN.hs
+++ b/src/Game/Chess/PGN.hs
@@ -181,7 +181,7 @@
     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
+moveDoc ro p (o,f) = fillSep (go p True f <> [pretty o]) <> line where
   go _ _ [] = []
   go pos pmn (t:ts)
     | color pos == White || pmn
@@ -192,11 +192,11 @@
     pl = ply . rootLabel $ t
     san = pretty $ unsafeToSAN pos pl
     pos' = unsafeDoPly pos pl
-    pnag = nag <$> prefixNAG (rootLabel t)
+    pnag = prettynag <$> 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
+    snag = prettynag <$> suffixNAG (rootLabel t)
+  prettynag n = "$" <> pretty n
 
 weightedForest :: PGN -> Forest (Rational, Ply)
 weightedForest (PGN games) = merge . concatMap rate $ snd <$> filter ok games
@@ -206,6 +206,7 @@
     w c | o == Win c = 1
         | o == Win (opponent c) = -1
         | o == Draw = 1 % 2
+        | otherwise = 0
     f pos (Node a ts') = Node (w (color pos), ply a) $
       f (unsafeDoPly pos (ply a)) <$> ts'
   trunk [] = []
diff --git a/src/Game/Chess/QuadBitboard.hs b/src/Game/Chess/QuadBitboard.hs
--- a/src/Game/Chess/QuadBitboard.hs
+++ b/src/Game/Chess/QuadBitboard.hs
@@ -5,6 +5,7 @@
 , pawns, knights, bishops, rooks, queens, kings
 , wPawns, wKnights, wBishops, wRooks, wQueens, wKings
 , bPawns, bKnights, bBishops, bRooks, bQueens, bKings
+, insufficientMaterial
 , toString
   -- * Square codes
 , Word4(..)
@@ -30,16 +31,26 @@
 ) where
 
 import Control.Applicative (liftA2)
-import Data.Binary
+import Data.Binary ( Word8, Word64, Binary(put, get) )
 import Data.Bits
+    ( Bits(xor, complement, bit, unsafeShiftR, (.&.), unsafeShiftL,
+           (.|.), testBit, setBit, clearBit, popCount),
+      FiniteBits(..) )
 import Data.Char (ord, toLower)
-import Data.Ix
+import Data.Ix ( Ix(inRange) )
 import Data.List (groupBy, intercalate)
 import Data.String (IsString(..))
 import qualified Data.Vector.Generic as G
 import qualified Data.Vector.Generic.Mutable as M
 import Data.Vector.Unboxed (Vector, MVector, Unbox)
+import Foreign.Storable
 import GHC.Enum
+    ( boundedEnumFrom,
+      boundedEnumFromThen,
+      predError,
+      succError,
+      toEnumError )
+import GHC.Ptr (castPtr, plusPtr)
 import Numeric (showHex)
 
 data QuadBitboard = QBB { black :: {-# UNPACK #-} !Word64
@@ -48,6 +59,34 @@
                         , rqk :: {-# UNPACK #-} !Word64
                         } deriving (Eq)
 
+insufficientMaterial :: QuadBitboard -> Bool
+insufficientMaterial qbb@QBB{black, pbq, nbk, rqk} =
+  noPawnsNorQueens && eachSideHasOneKing && noRooks &&
+  (oneSideHasAtMostOneMinorPiece || opposingBishopsOnEquallyColoredSquares)
+ where
+  eachSideHasOneKing = popCount (wKings qbb) == 1 && popCount (bKings qbb) == 1
+  noPawnsNorQueens = pbq `xor` bishops qbb == 0
+  noRooks = popCount rqk == 2
+  oneSideHasAtMostOneMinorPiece =
+    (popCount (nbk .&. complement black) == 1 && atMostOneMinorPiece black) ||
+    (popCount (nbk .&. black) == 1 && atMostOneMinorPiece (complement black))
+  opposingBishopsOnEquallyColoredSquares =
+    popCount (knights qbb) == 0 &&
+    popCount (nbk .&. black) == 2 && popCount (nbk .&. complement black) == 2 &&
+    even (countTrailingZeros (wBishops qbb)) ==
+    even (countTrailingZeros (bBishops qbb))
+  atMostOneMinorPiece mask = popCount (nbk .&. mask) `elem` [1,2]
+
+instance Storable QuadBitboard where
+  sizeOf _ = 32
+  alignment _ = 8
+  peek p = QBB <$> peek (castPtr p) <*> peek (castPtr $ p `plusPtr` 8) <*> peek (castPtr $ p `plusPtr` 16) <*> peek (castPtr $ p `plusPtr` 24)
+  poke p QBB{black, pbq, nbk, rqk} = do
+    poke (castPtr $ p) black
+    poke (castPtr $ p `plusPtr` 8) pbq
+    poke (castPtr $ p `plusPtr` 16) nbk
+    poke (castPtr $ p `plusPtr` 24) rqk
+
 newtype instance MVector s QuadBitboard = MV_QuadBitboard (MVector s (Word64, Word64, Word64, Word64))
 newtype instance Vector    QuadBitboard = V_QuadBitboard (Vector (Word64, Word64, Word64, Word64))
 instance Unbox QuadBitboard
@@ -193,7 +232,7 @@
 
 (!) :: QuadBitboard -> Int -> Word4
 (!) QBB{..} sq = fromIntegral $ f black 0 .|. f pbq 1 .|. f nbk 2 .|. f rqk 3 where
-  f bb n = ((bb `unsafeShiftR` sq) .&. 1) `unsafeShiftL` n
+  f !bb !n = ((bb `unsafeShiftR` sq) .&. 1) `unsafeShiftL` n
 
 setNibble :: Bits nibble => QuadBitboard -> Int -> nibble -> QuadBitboard
 setNibble QBB{..} sq nb = QBB (f 0 black) (f 1 pbq) (f 2 nbk) (f 3 rqk) where
diff --git a/src/Game/Chess/SAN.hs b/src/Game/Chess/SAN.hs
new file mode 100644
--- /dev/null
+++ b/src/Game/Chess/SAN.hs
@@ -0,0 +1,305 @@
+{-# LANGUAGE PolyKinds, FlexibleInstances, GADTs, ScopedTypeVariables #-}
+module Game.Chess.SAN (
+  strictSAN, relaxedSAN, fromSAN,
+  toSAN, unsafeToSAN, varToSAN
+) where
+
+import           Control.Applicative (Applicative(liftA2))
+import           Control.Arrow ((&&&))
+import           Data.Bifunctor (first)
+import qualified Data.ByteString as Strict (ByteString)
+import qualified Data.ByteString.Lazy as Lazy (ByteString)
+import           Data.Char (chr, ord)
+import           Data.Functor (($>))
+import           Data.List (sortOn)
+import           Data.List.Extra (chunksOf)
+import           Data.Maybe (fromJust)
+import           Data.Ord (Down(..))
+import           Data.Proxy ( Proxy(..) )
+import           Data.String (IsString(fromString))
+import qualified Data.Text as Strict (Text)
+import qualified Data.Text.Lazy as Lazy (Text)
+import           Data.Traversable (mapAccumL)
+import           Data.Void (Void)
+import           Data.Word ( Word8 )
+import Game.Chess.Internal ( Castle(Queenside, Kingside),
+                             Ply, Position(color, moveNumber), Color(Black, White),
+                             PieceType(..), isCapture, pieceAt, toRF, toCoord,
+                             promoteTo, unpack, doPly, unsafeDoPly, legalPlies,
+                             inCheck, canCastleKingside, canCastleQueenside,
+                             wKscm, wQscm, bKscm, bQscm )
+import Text.Megaparsec ( optional, (<|>), empty, (<?>), chunk, parse,
+                         errorBundlePretty, choice, option, Parsec,
+                         MonadParsec(try, token),
+                         Stream, TraversableStream, VisualStream,
+                         Token, Tokens, chunkLength )
+
+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 (Eq, Show)
+
+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
+  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
+
+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 sq)) (unpack -> (from', to', prm')) =
+      pAt from' == pc && from' == sq && 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 :: (VisualStream s, TraversableStream s, SANToken (Token s), IsString (Tokens s))
+        => Position -> s -> Either String Ply
+fromSAN pos = first errorBundlePretty . parse (relaxedSAN pos) ""
+
+toSAN :: IsString s => Position -> Ply -> s
+toSAN pos m
+  | m `elem` legalPlies pos = fromString $ unsafeToSAN pos m
+  | otherwise          = error "Game.Chess.toSAN: Illegal move"
+
+varToSAN :: IsString s => Position -> [Ply] -> s
+varToSAN _ [] = ""
+varToSAN pos plies
+  | color pos == Black && length plies == 1
+  = fromString $ show (moveNumber pos) <> "..." <> toSAN pos (head plies)
+  | color pos == Black
+  = fromString $ show (moveNumber pos) <> "..." <> toSAN pos (head plies) <> " " <> fromWhite (doPly pos (head plies)) (tail plies)
+  | otherwise
+  = fromString $ fromWhite pos plies
+ 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
+  f _ [] = []
+
+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 sq (unpack -> (_, to', _)) = sq == 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 | capture -> fileChar from : target <> promotion
+         | otherwise -> target <> promotion
+    King | color pos == White && m == wKscm -> "O-O"
+         | color pos == White && m == wQscm -> "O-O-O"
+         | color pos == Black && m == bKscm -> "O-O"
+         | color pos == Black && m == bQscm -> "O-O-O"
+         | otherwise -> 'K' : target
+    Knight -> 'N' : source <> target
+    Bishop -> 'B' : source <> target
+    Rook   -> 'R' : source <> target
+    Queen  -> 'Q' : source <> target
+  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                   = toCoord from
+  target
+    | 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 (legalPlies nextPos)
+         = "#"
+         | inCheck (color nextPos) nextPos
+         = "+"
+         | otherwise
+         = ""
+  nextPos = unsafeDoPly pos m
+  ms = filter movesTo $ legalPlies pos
+  movesTo (unpack -> (from', 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) = toRF from
+  fileChar i = chr $ (i `mod` 8) + ord 'a'
+  rankChar i = chr $ (i `div` 8) + ord '1'
+
+{-# 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/Tree.hs b/src/Game/Chess/Tree.hs
new file mode 100644
--- /dev/null
+++ b/src/Game/Chess/Tree.hs
@@ -0,0 +1,17 @@
+module Game.Chess.Tree where
+
+import Data.Tree ( Tree(Node), Forest )
+import Game.Chess.Internal
+
+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
+
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
@@ -2,7 +2,7 @@
   -- * Exceptions
   UCIException(..)
   -- * The Engine data type
-, Engine, name, author
+, Engine, BestMove, name, author
   -- * Starting a UCI engine
 , start, start'
   -- * Engine options
@@ -24,7 +24,7 @@
 
 import Control.Applicative
 import Control.Concurrent
-import Control.Concurrent.STM
+import Control.Concurrent.STM hiding (check)
 import Control.Exception
 import Control.Monad
 import Control.Monad.IO.Class
@@ -49,6 +49,8 @@
 import Time.Rational
 import Time.Units
 
+type BestMove = Maybe (Ply, Maybe Ply)
+
 data Engine = Engine {
   inH :: Handle
 , outH :: Handle
@@ -61,7 +63,7 @@
 , isReady :: MVar ()
 , isSearching :: IORef Bool
 , infoChan :: TChan [Info]
-, bestMoveChan :: TChan (Ply, Maybe Ply)
+, bestMoveChan :: TChan BestMove
 , game :: IORef (Position, [Ply])
 }
 
@@ -80,13 +82,13 @@
 
 instance Exception UCIException
 
-data Command = Name ByteString
-             | Author ByteString
-             | Option ByteString Option
+data Command = Name !ByteString
+             | Author !ByteString
+             | Option !ByteString !Option
              | UCIOk
              | ReadyOK
              | Info [Info]
-             | BestMove !(Ply, Maybe Ply)
+             | BestMove !BestMove
              deriving (Show)
 
 data Info = PV [Ply]
@@ -129,7 +131,7 @@
   , "uciok" $> UCIOk
   , "readyok" $> ReadyOK
   , "info" `kv` fmap Info (sepBy1 infoItem skipSpace)
-  , "bestmove" `kv` bestmove
+  , "bestmove" `kv` ("(none)" $> BestMove Nothing <|> bestmove)
   ] <* skipSpace
  where
   name = Name <$> kv "name" takeByteString
@@ -170,7 +172,7 @@
          <|> NPS <$> kv "nps" decimal
          <|> HashFull <$> kv "hashfull" decimal
          <|> TBHits <$> kv "tbhits" decimal
-         <|> Elapsed . ms . fromIntegral <$> kv "time" decimal
+         <|> Elapsed . ms . fromInteger <$> kv "time" decimal
          <|> kv "pv" pv
          <|> kv "currmove" currmove
          <|> CurrMoveNumber <$> kv "currmovenumber" decimal
@@ -182,9 +184,9 @@
                                 <|> LowerBound <$ "lowerbound"
                                  )
     pure $ Score s b
-  pv = fmap (PV . snd) $ foldM toPly (pos, []) =<< sepBy mv skipSpace
+  pv = fmap (PV . reverse . snd) $ foldM toPly (pos, []) =<< sepBy mv skipSpace
   toPly (pos, xs) s = case fromUCI pos s of
-    Just m -> pure (doPly pos m, xs <> [m])
+    Just m -> pure (unsafeDoPly pos m, m : xs)
     Nothing -> fail $ "Failed to parse move " <> s
   currmove = fmap (fromUCI pos) mv >>= \case
     Just m -> pure $ CurrMove m
@@ -202,9 +204,9 @@
     ponder <- optional (skipSpace *> kv "ponder" mv)
     case fromUCI pos m of
       Just m' -> case ponder of
-        Nothing -> pure $ BestMove (m', Nothing)
+        Nothing -> pure . BestMove . Just $ (m', Nothing)
         Just p -> case fromUCI (doPly pos m') p of
-          Just p' -> pure $ BestMove (m', Just p')
+          Just p' -> pure . BestMove . Just $ (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
@@ -320,7 +322,7 @@
 -- | Instruct the engine to begin searching.
 search :: MonadIO m
        => Engine -> [SearchParam]
-       -> m (TChan (Ply, Maybe Ply), TChan [Info])
+       -> m (TChan BestMove, TChan [Info])
 search e@Engine{isSearching} params = liftIO $ do
   chans <- atomically $ (,) <$> dupTChan (bestMoveChan e)
                             <*> dupTChan (infoChan e)
diff --git a/test/Perft.hs b/test/Perft.hs
--- a/test/Perft.hs
+++ b/test/Perft.hs
@@ -12,6 +12,9 @@
 import System.Exit
 import System.IO
 
+type Depth = Int
+type Testsuite = [(Position, [(Depth, PerftResult)])]
+
 main :: IO ()
 main = do
   start <- getCurrentTime
@@ -43,10 +46,10 @@
 instance Monoid PerftResult where
   mempty = PerftResult 0
 
-showResult :: Int -> PerftResult -> String
+showResult :: Depth -> PerftResult -> String
 showResult depth PerftResult{nodes} = show depth <> " " <> show nodes
 
-perft :: Int -> Position -> PerftResult
+perft :: Depth -> Position -> PerftResult
 perft 0 _ = PerftResult 1
 perft 1 p = PerftResult . fromIntegral . length $ legalPlies p
 perft n p
@@ -55,7 +58,7 @@
   | otherwise
   = fold . parMap rdeepseq (perft (pred n) . unsafeDoPly p) $ legalPlies p
 
-runTestSuite :: [(Position, [(Int, PerftResult)])] -> IO (Maybe PerftResult)
+runTestSuite :: Testsuite -> IO (Maybe PerftResult)
 runTestSuite = fmap (getAp . foldMap Ap) . traverse (uncurry (test mempty)) where
   test sum pos ((depth, expected) : more)
     | result == expected
@@ -73,7 +76,7 @@
          fen = toFEN pos
   test sum _ [] = pure (Just sum)
 
-readTestSuite :: FilePath -> IO [(Position, [(Int, PerftResult)])]
+readTestSuite :: FilePath -> IO Testsuite
 readTestSuite fp = do
   epd <- readFile fp
   pure $ fmap readData . (\ws -> (fromJust (fromFEN (unwords $ take 6 ws)), drop 6 ws)) . words <$> lines epd