chessIO 0.9.1.0 → 0.9.2.0

raw patch · 8 files changed

+57/−390 lines, 8 filesdep −brickdep −filepathdep −rosezipperdep ~prettyprinterPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies removed: brick, filepath, rosezipper, vty

Dependency ranges changed: prettyprinter

API changes (from Hackage documentation)

Files

• ChangeLog.md +5/−0
• README.md +0/−46
• app/cbookview.hs +0/−246
• app/polyplay.hs +3/−3
• book/twic-9g.bin too large to diff
• chessIO.cabal +7/−48
• src/Game/Chess/Internal.hs +2/−2
• src/Game/Chess/PGN.hs +40/−45

@@ -1,5 +1,10 @@ # Releases +## chessIO 0.9.2.0++- Move `cbookview` into a separate repository, removing the build-dep on brick+- Update internal book+ ## chessIO 0.9.1.0  - Add a Binary instance for Square

@@ -30,49 +30,3 @@  To launch a chess engine, simply pass its executable name and arguments to cboard. For instance, `cboard stockfish`.--## Opening book explorer--`cbookview` is a terminal application to explore commonly played openings.-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.

@@ -1,246 +0,0 @@-{-# LANGUAGE LambdaCase        #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE RecordWildCards   #-}-{-# LANGUAGE TemplateHaskell   #-}-{-# LANGUAGE ViewPatterns      #-}-import           Brick.AttrMap        (AttrName, attrMap)-import qualified Brick.Focus          as F-import           Brick.Main           (App (..), continue, defaultMain, halt)-import           Brick.Types          (BrickEvent (VtyEvent), EventM,-                                       Location (Location), Next, Widget)-import           Brick.Util           (on)-import           Brick.Widgets.Border (border, borderWithLabel)-import           Brick.Widgets.Center (hCenter)-import           Brick.Widgets.Core   (hBox, hLimit, showCursor, str, strWrap,-                                       txt, txtWrap, vBox, vLimit, withAttr,-                                       (<+>), (<=>))-import qualified Brick.Widgets.List   as L-import           Control.Lens         (makeLenses, over, view, (&), (.~), (^.))-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)-import qualified Data.List.NonEmpty   as NonEmpty-import           Data.Map             (Map)-import qualified Data.Map             as Map-import           Data.Maybe           (fromJust, fromMaybe)-import           Data.Tree            (Tree (..), foldTree)-import           Data.Tree.Zipper     (Full, TreePos, fromForest, label,-                                       nextTree)-import qualified Data.Tree.Zipper     as TreePos-import qualified Data.Vector          as Vector-import           Game.Chess           (Color (..), PieceType (..), Ply,-                                       Position, Square (A1, H8), color, doPly,-                                       isDark, pieceAt, plyTarget, startpos,-                                       toFEN)-import           Game.Chess.ECO       (Opening (..), defaultECO)-import qualified Game.Chess.ECO       as ECO-import           Game.Chess.PGN       (pgnForest, readPGNFile)-import           Game.Chess.Polyglot  (bookForest, defaultBook,-                                       readPolyglotFile)-import           Game.Chess.SAN       (toSAN, varToSAN)-import           Game.Chess.Tree      (plyForest)-import qualified Graphics.Vty         as V-import           System.Environment   (getArgs)-import           System.FilePath--data Name = List | Board | BoardStyle deriving (Show, Ord, Eq)--type Style a = Position -> Square -> Widget a--data St = St { _initialPosition :: Position-             , _treePos         :: TreePos Full (NonEmpty Ply)-             , _boardStyle      :: L.List Name (String, Style Name)-             , _focusRing       :: F.FocusRing Name-             }--makeLenses ''St--initialState :: St-initialState = St { .. } where-  _initialPosition = startpos-  _treePos = fromJust . nextTree . fromForest-           $ pathTree <$> bookForest defaultBook _initialPosition-  _boardStyle = L.list BoardStyle (Vector.fromList styles) 1-  _focusRing = F.focusRing [List, Board, BoardStyle]--position, previousPosition :: St -> Position-position st = foldl' doPly (st^.initialPosition) (st^.treePos & label)-previousPosition st = foldl' doPly (st^.initialPosition) (st^.treePos & label & NonEmpty.init)--targetSquare :: St -> Square-targetSquare = plyTarget . NonEmpty.last . label . view treePos--elemList :: Eq a => n -> a -> [a] -> L.List n a-elemList n x xs = L.list n (Vector.fromList xs) 1 & L.listSelectedL .~ i where-  i = x `elemIndex` xs--plyList :: St -> L.List Name Ply-plyList (_treePos -> tp) = elemList List ply plies where-  ply = NonEmpty.last . TreePos.label $ tp-  plies = fmap (NonEmpty.last . rootLabel) . TreePos.forest $ tp--selectedAttr :: AttrName-selectedAttr = "selected"--renderPosition :: Position -> Color -> Maybe Square -> 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 " "])-  files = str $ rev "   a b c d e f g h   "-  board = hLimit 17 . vLimit 8 . vBox $ map (hBox . spacer . map pc) squares-  squares = reverse $ chunksOf 8 $ rev [A1 .. H8]-  pc sq = putCursorIf (tgt == Just sq) Board (0,0) $ 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 = [ ("English",  english)-         , ("Deutsch",  german)-         , ("Figurine", figurine)-         ]- where-  german pos sq = case pieceAt pos sq of-    Just piece           -> str . pure $ "bsltdkBSLTDK" !! index allPieces piece-    Nothing | isDark sq  -> str "+"-            | otherwise  -> str " "-  figurine pos sq = case pieceAt pos sq of-    Just piece           -> str . pure $ "♟♞♝♜♛♚♙♘♗♖♕♔" !! index allPieces piece-    Nothing | isDark sq  -> str "+"-            | otherwise  -> str " "--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-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 :: 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 :: Map V.Event Command-keyMap = Map.fromList $ 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)-    ]--cbookview :: App St e Name-cbookview = App { .. } where-  appStartEvent = pure-  appDraw st = [ui] where-    ui = hBox [ hLimit 9 list-              , hLimit 23 $ hCenter board <=> str " " <=> eco-              , hCenter . hLimit 40 $ str " " <=> var-              ]-      <=> str " "-      <=> (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 (q) = Quit"-               ]-    eco = maybe (str " ") drawECO (ECO.lookup (position st) defaultECO)-    drawECO co = borderWithLabel (str "ECO " <+> txt (coCode co)) $-      case coVariation co of-        Nothing        -> txtWrap (coName co)-        Just variation -> txtWrap (coName co) <=> txtWrap variation-    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 List (0,0)-                  . withAttrIf foc selectedAttr-                  . str . toSAN p-    board = renderPosition (position st) (color (previousPosition st)) (Just . targetSquare $ st) selectedStyle-    var = strWrap . varToSAN (st^.initialPosition) $ st^.treePos & TreePos.label & toList-    fen = str . toFEN $ position st-  appHandleEvent st (VtyEvent e) = fromMaybe continue (Map.lookup e keyMap) st-  appHandleEvent st _            = continue st-  appAttrMap = const $ attrMap V.defAttr-             [(selectedAttr, V.white `on` V.green)-             ]-  appChooseCursor = F.focusRingCursor (view focusRing)--loadForest :: (Position -> [Tree Ply]) -> Position -> St -> Maybe St-loadForest f p st = case f p of-  [] -> Nothing-  ts -> Just $ st & initialPosition .~ p & treePos .~ tp where-    tp = fromJust . nextTree . fromForest $ pathTree <$> ts--pathTree :: Tree a -> Tree (NonEmpty a)-pathTree = foldTree $ \a -> Node (pure a) . (fmap . fmap) (NonEmpty.cons a)--main :: IO ()-main = do-  as <- getArgs-  case as of-    [] -> void $ defaultMain cbookview initialState-    [fp] -> case takeExtension fp of-      ".bin" -> do-        book <- readPolyglotFile fp-        case loadForest (bookForest book) startpos initialState of-          Just st -> void $ defaultMain cbookview st-          Nothing -> putStrLn "No moves found in book"-      ".pgn" -> readPGNFile fp >>= \case-        Right pgn -> case loadForest (const $ pgnForest pgn) startpos initialState of-          Just st -> void $ defaultMain cbookview st-          Nothing -> putStrLn "No moves found in PGN"-        Left err -> putStrLn err-      ext -> putStrLn $ "Unknown extension " <> ext <> ", only .bin (polyglot) and .pgn is supposed"-    _ -> putStrLn "Too many arguments."

@@ -13,8 +13,7 @@ import           Data.IORef import           Data.List import           Data.String-import           Data.Text.Encoding                    (decodeUtf8)-import           Data.Text.Prettyprint.Doc.Render.Text+import           Data.Text.Encoding        (decodeUtf8) import           Data.Time.Clock import           Data.Tree import           Game.Chess@@ -23,7 +22,8 @@ import           Game.Chess.SAN import           Game.Chess.UCI import           Options.Applicative-import           System.IO                             (hPutStrLn, stderr)+import           Prettyprinter.Render.Text+import           System.IO                 (hPutStrLn, stderr) import           Time.Units  data Clock = Clock !Color !NominalDiffTime !NominalDiffTime !UTCTime

file too large to diff

@@ -5,9 +5,9 @@ -- see: https://github.com/sol/hpack  name:           chessIO-version:        0.9.1.0+version:        0.9.2.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.+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. category:       Game homepage:       https://github.com/mlang/chessIO#readme bug-reports:    https://github.com/mlang/chessIO/issues@@ -66,7 +66,7 @@     , megaparsec >=9.0     , mono-traversable     , o-clock-    , prettyprinter+    , prettyprinter >=1.7.0     , process     , random     , stm@@ -105,7 +105,7 @@     , mono-traversable     , mtl     , o-clock-    , prettyprinter+    , prettyprinter >=1.7.0     , process     , random     , stm@@ -119,47 +119,6 @@     , vector-instances   default-language: Haskell2010 -executable cbookview-  main-is: cbookview.hs-  other-modules:-      Paths_chessIO-  hs-source-dirs:-      app-  ghc-options: -O2 -threaded-  build-depends:-      MonadRandom-    , attoparsec-    , base >=4.10 && <5-    , binary-    , brick-    , bytestring-    , chessIO-    , containers-    , deepseq-    , extra-    , file-embed-    , filepath-    , hashable-    , lens-    , megaparsec >=9.0-    , mono-traversable-    , o-clock-    , prettyprinter-    , process-    , random-    , rosezipper-    , stm-    , template-haskell >=2.9.0.0-    , text-    , th-compat >=0.1.2-    , th-lift-instances-    , unordered-containers-    , vector-    , vector-binary-instances-    , vector-instances-    , vty-  default-language: Haskell2010- executable polyplay   main-is: polyplay.hs   other-modules:@@ -184,7 +143,7 @@     , mono-traversable     , o-clock     , optparse-applicative-    , prettyprinter+    , prettyprinter >=1.7.0     , process     , random     , stm@@ -225,7 +184,7 @@     , mono-traversable     , o-clock     , parallel-    , prettyprinter+    , prettyprinter >=1.7.0     , process     , random     , stm@@ -265,7 +224,7 @@     , megaparsec >=9.0     , mono-traversable     , o-clock-    , prettyprinter+    , prettyprinter >=1.7.0     , process     , random     , stm

@@ -524,7 +524,7 @@       forBits singlePushTargets $ \dst ->         pawn (dst - 8) dst       forBits doublePushTargets $ \dst ->-        pawn (dst - 16) dst+        add $ move (Sq $ dst - 16) (Sq dst)        piecePlies (QBB.wKnights qbb)                  (QBB.wBishops qbb)@@ -567,7 +567,7 @@       forBits singlePushTargets $ \dst ->         pawn (dst + 8) dst       forBits doublePushTargets $ \dst ->-        pawn (dst + 16) dst+        add $ move (Sq $ dst + 16) (Sq dst)        piecePlies (QBB.bKnights qbb)                  (QBB.bBishops qbb)

@@ -36,51 +36,46 @@ , weightedForest ) where -import           Control.Lens                          (makeLenses, makePrisms,-                                                        makeWrapped)-import           Control.Monad                         (void)-import           Control.Monad.IO.Class                (MonadIO (..))-import           Data.Bifunctor                        (Bifunctor (first))-import           Data.ByteString.Char8                 (ByteString)-import qualified Data.ByteString.Char8                 as BS-import           Data.Char                             (chr, ord)-import           Data.Foldable                         (for_)-import           Data.Functor                          (($>))-import           Data.Hashable                         (Hashable (..))-import           Data.List                             (partition, sortOn)-import           Data.Maybe                            (fromJust, isNothing)-import           Data.Ord                              (Down (Down))-import           Data.Ratio                            ((%))-import           Data.Text                             (Text)-import qualified Data.Text                             as T-import           Data.Text.Encoding                    as T (decodeUtf8)-import           Data.Text.Prettyprint.Doc             (Doc,-                                                        FusionDepth (Shallow),-                                                        Pretty (pretty),-                                                        brackets, dquotes,-                                                        fillSep, fuse, line,-                                                        parens, vsep, (<+>))-import           Data.Text.Prettyprint.Doc.Render.Text (hPutDoc)-import           Data.Tree                             (Tree (..), foldTree)-import           Data.Void                             (Void)-import           Data.Word                             (Word8)-import           GHC.Generics                          (Generic)-import           Game.Chess.Internal                   (Color (..), Ply,-                                                        Position (color, moveNumber),-                                                        fromFEN, startpos,-                                                        unsafeDoPly)-import           Game.Chess.SAN                        (relaxedSAN, unsafeToSAN)-import           Language.Haskell.TH.Syntax            (Lift)-import           System.IO                             (Handle, hPutStrLn)-import           Text.Megaparsec                       (MonadParsec (eof),-                                                        Parsec, anySingleBut,-                                                        errorBundlePretty, many,-                                                        match, oneOf, optional,-                                                        parse, single, (<?>),-                                                        (<|>))-import           Text.Megaparsec.Byte                  (alphaNumChar, space,-                                                        space1, string)-import qualified Text.Megaparsec.Byte.Lexer            as L+import           Control.Lens               (makeLenses, makePrisms,+                                             makeWrapped)+import           Control.Monad              (void)+import           Control.Monad.IO.Class     (MonadIO (..))+import           Data.Bifunctor             (Bifunctor (first))+import           Data.ByteString.Char8      (ByteString)+import qualified Data.ByteString.Char8      as BS+import           Data.Char                  (chr, ord)+import           Data.Foldable              (for_)+import           Data.Functor               (($>))+import           Data.Hashable              (Hashable (..))+import           Data.List                  (partition, sortOn)+import           Data.Maybe                 (fromJust, isNothing)+import           Data.Ord                   (Down (Down))+import           Data.Ratio                 ((%))+import           Data.Text                  (Text)+import qualified Data.Text                  as T+import           Data.Text.Encoding         as T (decodeUtf8)+import           Data.Tree                  (Tree (..), foldTree)+import           Data.Void                  (Void)+import           Data.Word                  (Word8)+import           GHC.Generics               (Generic)+import           Game.Chess.Internal        (Color (..), Ply,+                                             Position (color, moveNumber),+                                             fromFEN, startpos, unsafeDoPly)+import           Game.Chess.SAN             (relaxedSAN, unsafeToSAN)+import           Language.Haskell.TH.Syntax (Lift)+import           Prettyprinter                (Doc, FusionDepth (Shallow),+                                             Pretty (pretty), brackets, dquotes,+                                             fillSep, fuse, line, parens, vsep,+                                             (<+>))+import           Prettyprinter.Render.Text    (hPutDoc)+import           System.IO                  (Handle, hPutStrLn)+import           Text.Megaparsec            (MonadParsec (eof), Parsec,+                                             anySingleBut, errorBundlePretty,+                                             many, match, oneOf, optional,+                                             parse, single, (<?>), (<|>))+import           Text.Megaparsec.Byte       (alphaNumChar, space, space1,+                                             string)+import qualified Text.Megaparsec.Byte.Lexer as L  data Annotated a = Ann {   _annPrefixNAG :: ![Int]