packages feed

chessIO 0.6.0.0 → 0.6.1.0

raw patch · 10 files changed

+176/−56 lines, 10 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

+ Game.Chess: enPassantSquare :: Position -> Maybe Sq

Files

CHANGELOG.md view
@@ -1,5 +1,13 @@ # Releases +## chessIO 0.6.1.0++- Add enPassantSquare (thanks Tochi Obudulu).+- cbookview:+  - piece styles+  - Key End now moves to the final position of the most popular game+  - FEN string display+ ## chessIO 0.6.0.0  - Optimize `foldBits`.
README.md view
@@ -32,10 +32,45 @@ ## Opening book explorer  `cbookview` is a terminal application to explore commonly played openings.-Passing a polyglot opening book file (with extension `.bin`) will allow you to-explore the plies contained in that book file interactively.+Passing a polyglot opening book file (with extension `.bin`) on the command line+will allow you to explore the plies contained in that book file interactively. You can also open a PGN file (extension `.pgn`) which will be presented like it was an opening book.  In other words, all the moves played in that PGN file will be merged into a single forest of plies.  When exporing PGN files, no particular order of plies is imposed.  When exploring a polyglot file the most popular moves will always come first.++For example, lets assume you want to examine blacks replies to+the [Ruy lopez](https://en.wikipedia.org/wiki/Ruy_Lopez).  Use the cursor keys+to navigate to the move after bishop b5.+Here is what the interface will show:++```+a6         ┌─────────────────┐+Nf6       1│ R +   K Q B N R │        1.e4 e5 2.Nf3 Nc6 3.Bb5 a6+g6        2│ P P P   P P P P │+f5        3│   + N +   +   + │+Nge7      4│ +   + P +   +   │+Bc5       5│   +   p   + B + │+d6        6│ +   +   + n + p │+Nd4       7│ p p p + p p p + │+Bb4       8│ r n b k q b + r │+Bd6        └─────────────────┘+Qf6          h g f e d c b a+f6++++Up/Down (kj) = change ply, Left/Right (hl) = back/forward                 ESC = Quit+```++Moving the cursor down the list of book moves will also update the+position and game history.  As already mentioned, the moves in polyglot book files+are ordered according to popularity.  So pawn to a6 is actually the+most popular line of the Ruy Lopez.++### The easteregg: Poor mans chessboard++If you press `a` (for "All moves") cbookview will switch to the tree+of all possible moves.  This is a poor mans way for following+games and abusing cbookview as a two-player board.
app/cbookview.hs view
@@ -2,6 +2,7 @@ import Prelude hiding (last) import Control.Monad ( void ) import Data.Foldable ( foldl', toList )+import Data.Ix import Data.List ( elemIndex, intersperse ) import Data.List.Extra ( chunksOf ) import Data.List.NonEmpty (NonEmpty)@@ -14,7 +15,7 @@ import qualified Data.Tree.Zipper as TreePos import qualified Data.Vector as Vec import Game.Chess ( Color(..), PieceType(..), Sq(..), toIndex, isDark-                  , Position, color, startpos, pieceAt+                  , Position, color, startpos, pieceAt, toFEN                   , Ply, plyTarget, doPly                   ) import Game.Chess.Polyglot ( defaultBook, bookForest, readPolyglotFile )@@ -39,10 +40,13 @@ import System.FilePath import System.Environment ( getArgs ) -data Name = List | Board deriving (Show, Ord, Eq)+data Name = List | Board | BoardStyle deriving (Show, Ord, Eq) +type Style a = Position -> Sq -> Widget a+ data St = St { _initialPosition :: Position              , _treePos :: TreePos Full (NonEmpty Ply)+             , _boardStyle :: L.List Name (String, Style Name)              , _focusRing :: F.FocusRing Name              } @@ -67,8 +71,8 @@ selectedAttr :: AttrName selectedAttr = "selected" -renderPosition :: Position -> Color -> Maybe Int -> Widget Name-renderPosition pos persp tgt = ranks <+> border board <=> files where+renderPosition :: Position -> Color -> Maybe Int -> Style Name -> Widget Name+renderPosition pos persp tgt sty = ranks <+> border board <=> files where   rev :: [a] -> [a]   rev = if persp == Black then reverse else id   ranks = vBox (str " " : map (str . show) (rev [8 :: Int, 7..1]) <> [str " "])@@ -77,35 +81,91 @@   squares = reverse $ chunksOf 8 $ rev [A1 .. H8]   c sq | Just t <- tgt, t == toIndex sq = showCursor Board $ Location (0,0)        | otherwise                      = id-  pc sq = c sq $ case pieceAt pos sq of-    Just (White, Pawn)   -> str "P"-    Just (White, Knight) -> str "N"-    Just (White, Bishop) -> str "B"-    Just (White, Rook)   -> str "R"-    Just (White, Queen)  -> str "Q"-    Just (White, King)   -> str "K"-    Just (Black, Pawn)   -> str "p"-    Just (Black, Knight) -> str "n"-    Just (Black, Bishop) -> str "b"-    Just (Black, Rook)   -> str "r"-    Just (Black, Queen)  -> str "q"-    Just (Black, King)   -> str "k"+  pc sq = c sq $ sty pos sq+  spacer = (str " " :) . (<> [str " "]) . intersperse (str " ")++allPieces :: ((Color, PieceType), (Color, PieceType))+allPieces = ((Black, Pawn), (White, King))++english :: Style a+english pos sq = case pieceAt pos sq of+  Just piece           -> str . pure $ "pnbrqkPNBRQK" !! index allPieces piece+  Nothing | isDark sq  -> str "+"+          | otherwise  -> str " "++styles :: [(String, Style a)]+styles = map where+  map = [ ("English",  english)+        , ("Deutsch",  german)+        , ("Figurine", figurine)+        ]+  german pos sq = case pieceAt pos sq of+    Just piece           -> str . pure $ "bsltdkBSLTDK" !! index allPieces piece     Nothing | isDark sq  -> str "+"             | otherwise  -> str " "-  spacer = (str " " :) . (<> [str " "]) . intersperse (str " ")+  figurine pos sq = case pieceAt pos sq of+    Just piece           -> str . pure $ "♟♞♝♜♛♚♙♘♗♖♕♔" !! index allPieces piece+    Nothing | isDark sq  -> str "+"+            | otherwise  -> str " " -next, prev, firstChild, parent, root, nextCursor :: St -> EventM Name (Next St)-next = continue . over treePos (fromMaybe <*> TreePos.next)-prev = continue . over treePos (fromMaybe <*> TreePos.prev)+putCursorIf :: Bool -> n -> (Int, Int) -> Widget n -> Widget n+putCursorIf True n loc = showCursor n $ Location loc+putCursorIf False _ _  = id++withAttrIf :: Bool -> AttrName -> Widget n -> Widget n+withAttrIf True attr   = withAttr attr+withAttrIf False _     = id++type Command = St -> EventM Name (Next St)++next, prev, firstChild, parent, root, firstLeaf :: Command+next       = continue . over treePos (fromMaybe <*> TreePos.next)+prev       = continue . over treePos (fromMaybe <*> TreePos.prev) firstChild = continue . over treePos (fromMaybe <*> TreePos.firstChild)-parent = continue . over treePos (fromMaybe <*> TreePos.parent)-root = continue . over treePos TreePos.root+parent     = continue . over treePos (fromMaybe <*> TreePos.parent)+root       = continue . over treePos TreePos.root+firstLeaf  = continue . over treePos go where+  go tp = maybe tp go $ TreePos.firstChild tp++nextCursor, prevCursor :: Command nextCursor = continue . over focusRing F.focusNext+prevCursor = continue . over focusRing F.focusPrev -allPlies, internalBook :: St -> EventM Name (Next St)-allPlies = continue . (fromMaybe <*> loadForest plyForest startpos)+allPlies, internalBook :: Command+allPlies     = continue . (fromMaybe <*> loadForest plyForest startpos) internalBook = continue . (fromMaybe <*> loadForest (bookForest defaultBook) startpos) +nextStyle, prevStyle :: Command+nextStyle = continue . over boardStyle L.listMoveDown+prevStyle = continue . over boardStyle L.listMoveUp++keyMap :: [(V.Event, Command)]+keyMap = cursor <> vi <> common where+  cursor =+    [ (V.EvKey V.KDown [],       next)+    , (V.EvKey V.KUp [],         prev)+    , (V.EvKey V.KRight [],      firstChild)+    , (V.EvKey V.KLeft [],       parent)+    , (V.EvKey V.KHome [],       root)+    , (V.EvKey V.KEnd [],        firstLeaf)+    ]+  common =+    [ (V.EvKey (V.KChar '\t') [],        nextCursor)+    , (V.EvKey (V.KChar '\t') [V.MMeta], prevCursor)+    , (V.EvKey (V.KChar 'a') [],         allPlies)+    , (V.EvKey (V.KChar 'd') [],         internalBook)+    , (V.EvKey (V.KChar '+') [],         nextStyle)+    , (V.EvKey (V.KChar '-') [],         prevStyle)+    , (V.EvKey V.KEsc [],                halt)+    , (V.EvKey (V.KChar 'q') [],         halt)+    ]+  vi =+    [ (V.EvKey (V.KChar 'j') [], next)+    , (V.EvKey (V.KChar 'k') [], prev)+    , (V.EvKey (V.KChar 'l') [], firstChild)+    , (V.EvKey (V.KChar 'h') [], parent)+    ]+ app :: App St e Name app = App { .. } where   appStartEvent = pure@@ -114,36 +174,26 @@               , hLimit 23 $ hCenter board               , hCenter . hLimit 40 $ str " " <=> var               ]+      <=> (str "FEN: " <+> fen)+      <=> str " "+      <=> hBox [str "Board style (+/- to change): ", style]       <=> hBox [str "Up/Down (kj) = change ply, Left/Right (hl) = back/forward"                , hCenter $ str " "                , str "ESC = Quit"                ]+    style = vLimit 1 $ L.renderList drawStyle True (st^.boardStyle)+    drawStyle foc (n, _) = putCursorIf foc BoardStyle (0,0) $ str n+    selectedStyle = maybe english (snd . snd) $+      st^.boardStyle & L.listSelectedElement     list = L.renderList (drawPly (previousPosition st)) True (plyList st)-    drawPly p foc = putCursorIf foc (0,0)+    drawPly p foc = putCursorIf foc List (0,0)                   . withAttrIf foc selectedAttr                   . str . toSAN p -    putCursorIf True loc = showCursor List $ Location loc-    putCursorIf False _  = id-    withAttrIf True attr = withAttr attr-    withAttrIf False _   = id-    board = renderPosition (position st) (color (previousPosition st)) (Just . targetSquare $ st)+    board = renderPosition (position st) (color (previousPosition st)) (Just . targetSquare $ st) selectedStyle     var = strWrap . varToSAN (st^.initialPosition) $ st^.treePos & label & toList-  appHandleEvent st (VtyEvent e) = case e of-    V.EvKey V.KDown []        -> next st-    V.EvKey (V.KChar 'j') []  -> next st-    V.EvKey V.KUp []          -> prev st-    V.EvKey (V.KChar 'k') []  -> prev st-    V.EvKey V.KRight []       -> firstChild st-    V.EvKey (V.KChar 'l') []  -> firstChild st-    V.EvKey V.KLeft []        -> parent st-    V.EvKey (V.KChar 'h') []  -> parent st-    V.EvKey V.KHome []        -> root st-    V.EvKey (V.KChar '\t') [] -> nextCursor st-    V.EvKey (V.KChar 'a') []  -> allPlies st-    V.EvKey (V.KChar 'd') []  -> internalBook st-    V.EvKey V.KEsc []         -> halt st-    _                         -> continue st-  appHandleEvent st _          = continue st+    fen = str . toFEN $ position st+  appHandleEvent st (VtyEvent e) = fromMaybe continue (lookup e keyMap) st+  appHandleEvent st _            = continue st   appAttrMap = const $ attrMap V.defAttr              [(selectedAttr, V.white `on` V.green)              ]@@ -156,11 +206,12 @@     tp = fromJust . nextTree . fromForest . fmap pathTree $ ts  initialState :: St-initialState = St pos tp fr where+initialState = St pos tp sl fr where   tp = fromJust . nextTree . fromForest . fmap pathTree . bookForest defaultBook      $ pos   pos = startpos-  fr = F.focusRing [List, Board]+  fr = F.focusRing [List, Board, BoardStyle]+  sl = L.list BoardStyle (Vec.fromList styles) 1  main :: IO () main = do
book/twic-9g.bin view

file too large to diff

chessIO.cabal view
@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: 3073a8804ce426ada9f0b7ca90397b85f2bccbb35051187d1d41b5cd1e2192e2+-- hash: de80a5b1f8b0f93212816ed6945a0c402a0bf5ecdc280d53f32d0c195ce4a588  name:           chessIO-version:        0.6.0.0+version:        0.6.1.0 synopsis:       Basic chess library description:    A simple and fast 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, and a terminal program (cbookview) to explore commonly played chess openings. category:       Game
src/Game/Chess.hs view
@@ -31,7 +31,7 @@ , PieceType(..), Castle(..) , Position, startpos, color, moveNumber, halfMoveClock, pieceAt, inCheck , castlingRights, canCastleKingside, canCastleQueenside-, insufficientMaterial, repetitions+, insufficientMaterial, repetitions, enPassantSquare   -- ** Converting from/to Forsyth-Edwards-Notation , fromFEN, toFEN   -- * Chess moves
src/Game/Chess/Internal.hs view
@@ -507,6 +507,11 @@   bqs xs | flags `testMask` crbQs = (Black, Queenside):xs          | otherwise              = xs +enPassantSquare :: Position -> Maybe Sq+enPassantSquare Position{flags} = case flags .&. epMask of+  0 -> Nothing+  x -> Just $ toEnum $ bitScanForward x+ canCastleKingside, canCastleQueenside :: Position -> Bool canCastleKingside pos@Position{qbb} = canCastleKingside' pos (occupied qbb) canCastleQueenside pos@Position{qbb} = canCastleQueenside' pos (occupied qbb)
src/Game/Chess/PGN.hs view
@@ -1,6 +1,6 @@ {-# LANGUAGE GADTs #-} module Game.Chess.PGN (-  readPGNFile, gameFromForest, pgnForest, PGN(..), Game, Outcome(..)+  readPGNFile, gameFromForest, pgnForest, PGN(..), Game(..), Outcome(..) , hPutPGN, pgnDoc, RAVOrder, breadthFirst, depthFirst, gameDoc , weightedForest ) where
src/Game/Chess/SAN.hs view
@@ -1,6 +1,16 @@ {-# LANGUAGE PolyKinds, FlexibleInstances, GADTs, ScopedTypeVariables #-}+{-|+Module      : Game.Chess.SAN+Description : Standard Algebraic Notation+Copyright   : (c) Mario Lang, 2020+License     : BSD3+Maintainer  : mlang@blind.guru+Stability   : experimental++Parsers and printers for [Algebraic Notation](https://en.wikipedia.org/wiki/Algebraic_notation_%28chess%29).+-} module Game.Chess.SAN (-  -- " Conversion+  -- * Conversion   fromSAN, toSAN, unsafeToSAN   -- * Parsers , SANToken, strictSAN, relaxedSAN
src/Game/Chess/UCI.hs view
@@ -1,3 +1,14 @@+{-|+Module      : Game.Chess.UCI+Description : Universal Chess Interface+Copyright   : (c) Mario Lang, 2020+License     : BSD3+Maintainer  : mlang@blind.guru+Stability   : experimental++The Universal Chess Interface (UCI) is a protocol for communicating with+external Chess engines.+-} module Game.Chess.UCI (   -- * Exceptions   UCIException(..)