packages feed

fen2s (empty) → 1.0

raw patch · 6 files changed

+297/−0 lines, 6 filesdep +api-opentheory-unicodedep +basedep +opentheory-unicodesetup-changed

Dependencies added: api-opentheory-unicode, base, opentheory-unicode

Files

+ LICENSE view
@@ -0,0 +1,17 @@+Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to deal+in the Software without restriction, including without limitation the rights+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in+all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN+THE SOFTWARE.
+ Setup.hs view
@@ -0,0 +1,6 @@+module Main(main)++import Distribution.Simple++main :: IO ()+main = defaultMain
+ fen2s.cabal view
@@ -0,0 +1,50 @@+name: fen2s+version: 1.0+category: Game+synopsis: Converting a chess position from FEN notation to text+license: MIT+license-file: LICENSE+cabal-version: >= 1.8.0.2+build-type: Simple+author: Joe Leslie-Hurd <joe@gilith.com>+maintainer: Joe Leslie-Hurd <joe@gilith.com>+description:+  This package implements a simple utility to read in a chess position+  described in FEN notation and print it using Unicode characters.++Library+  build-depends:+    base >= 4.0 && < 5.0,+    opentheory-unicode >= 1.0 && < 2.0,+    api-opentheory-unicode >= 1.0 && < 2.0++  hs-source-dirs: src++  ghc-options: -Wall++  exposed-modules:+    Chess++executable fen2s+  build-depends:+    base >= 4.0 && < 5.0,+    opentheory-unicode >= 1.0 && < 2.0,+    api-opentheory-unicode >= 1.0 && < 2.0++  hs-source-dirs: src++  ghc-options: -Wall++  main-is: Main.hs++executable fen2s-test+  build-depends:+    base >= 4.0 && < 5.0,+    opentheory-unicode >= 1.0 && < 2.0,+    api-opentheory-unicode >= 1.0 && < 2.0++  hs-source-dirs: src++  ghc-options: -Wall++  main-is: Test.hs
+ src/Chess.hs view
@@ -0,0 +1,141 @@+{- |+module: Chess+description: Converting a chess position from FEN notation to text+license: MIT++maintainer: Joe Leslie-Hurd <joe@gilith.com>+stability: provisional+portability: portable+-}+module Chess+where++import qualified Data.Char as Char+import qualified Data.List as List++import OpenTheory.Unicode+import qualified Unicode++data Side =+    Black+  | White+  deriving (Eq,Ord,Show)++data Piece =+    King+  | Queen+  | Rook+  | Bishop+  | Knight+  | Pawn+  deriving (Eq,Ord,Show)++data Edge =+    NoEdge+  | SingleEdge+  | DoubleEdge+  deriving (Eq,Ord,Show)++newtype Board =+    Board { unBoard :: [[Maybe (Side,Piece)]] }+  deriving (Eq,Ord,Show)++emptySquareUnicode :: Unicode+emptySquareUnicode = Unicode 8729++fenToSide :: Char -> Side+fenToSide c = if Char.isLower c then Black else White++fenToPiece :: Char -> Piece+fenToPiece c =+    case Char.toLower c of+      'k' -> King+      'q' -> Queen+      'r' -> Rook+      'b' -> Bishop+      'n' -> Knight+      'p' -> Pawn+      _ -> error $ "bad FEN character: " ++ show c++fenToSidePiece :: Char -> (Side,Piece)+fenToSidePiece c = (fenToSide c, fenToPiece c)++fenToBoard :: String -> Board+fenToBoard =+    Board . uncurry (:) . foldr parse ([],[])+  where+    parse '/' (r,rs) = ([], r : rs)+    parse c (r,rs) =+        if Char.isDigit c+        then (replicate (Char.digitToInt c) Nothing ++ r, rs)+        else (Just (fenToSidePiece c) : r, rs)++stringToEdge :: String -> Edge+stringToEdge "0" = NoEdge+stringToEdge "1" = SingleEdge+stringToEdge "2" = DoubleEdge+stringToEdge _ = error "edge must be one of {0,1,2}"++-- http://en.wikipedia.org/wiki/Chess_symbols_in_Unicode+sidePieceToUnicode :: (Side,Piece) -> Unicode+sidePieceToUnicode p =+    Unicode codepoint+  where+    codepoint =+        case p of+          (White,King) -> 9812+          (White,Queen) -> 9813+          (White,Rook) -> 9814+          (White,Bishop) -> 9815+          (White,Knight) -> 9816+          (White,Pawn) -> 9817+          (Black,King) -> 9818+          (Black,Queen) -> 9819+          (Black,Rook) -> 9820+          (Black,Bishop) -> 9821+          (Black,Knight) -> 9822+          (Black,Pawn) -> 9823++squareToUnicode :: Maybe (Side,Piece) -> Unicode+squareToUnicode Nothing = emptySquareUnicode+squareToUnicode (Just p) = sidePieceToUnicode p++rankToUnicode :: [Maybe (Side,Piece)] -> [Unicode]+rankToUnicode = map squareToUnicode++boardToUnicode :: Edge -> Board -> [Unicode]+boardToUnicode e b =+    top ++ List.intercalate Unicode.newline (map rank (unBoard b)) ++ bottom+  where+    rank l = side ++ rankToUnicode l ++ side++    top = case e of+            NoEdge -> []+            SingleEdge -> singleTop+            DoubleEdge -> doubleTop++    side = case e of+             NoEdge -> []+             SingleEdge -> singleSide+             DoubleEdge -> doubleSide++    bottom = case e of+            NoEdge -> []+            SingleEdge -> singleBottom+            DoubleEdge -> doubleBottom++    singleTop = topEdge 9484 9472 9488+    singleSide = sideEdge 9474+    singleBottom = bottomEdge 9492 9472 9496++    doubleTop = topEdge 9556 9552 9559+    doubleSide = sideEdge 9553+    doubleBottom = bottomEdge 9562 9552 9565++    topEdge x y z = longEdge x y z ++ Unicode.newline+    sideEdge x = [Unicode x]+    bottomEdge x y z = Unicode.newline ++ longEdge x y z+    longEdge x y z = map Unicode ([x] ++ replicate 8 y ++ [z])++fenToUnicode :: String -> Edge -> [Unicode]+fenToUnicode f e = boardToUnicode e (fenToBoard f)
+ src/Main.hs view
@@ -0,0 +1,48 @@+{- |+module: Main+description: Convert a chess position from FEN notation to Unicode characters+license: MIT++maintainer: Joe Leslie-Hurd <joe@gilith.com>+stability: provisional+portability: portable+-}+module Main+  ( main )+where++import qualified System.Environment as Environment+import System.Console.GetOpt++import qualified Unicode+import qualified Chess++data Options = Options+    {optEdge :: Chess.Edge}+  deriving Show++defaultOptions :: Options+defaultOptions =+  Options+    {optEdge = Chess.SingleEdge}++options :: [OptDescr (Options -> Options)]+options =+    [Option ['e'] ["edge"]+       (ReqArg (\ n opts -> opts {optEdge = Chess.stringToEdge n}) "{0,1,2}")+       "board edge width"]++processOptions :: [String] -> (Options,String)+processOptions args =+    case getOpt Permute options args of+      (o,[f],[]) -> (foldl (flip id) defaultOptions o, f)+      (_,_,errs) -> error $ concat errs ++ usageInfo header options+  where+    header = "Usage: fen2s [OPTION...] FEN"++main :: IO ()+main =+    do args <- Environment.getArgs+       let (opts,fen) = processOptions args+       let edge = optEdge opts+       Unicode.encode (Chess.fenToUnicode fen edge ++ Unicode.newline)
+ src/Test.hs view
@@ -0,0 +1,35 @@+{- |+module: Main+description: Testing the FEN to Unicode conversion+license: MIT++maintainer: Joe Leslie-Hurd <joe@gilith.com>+stability: provisional+portability: portable+-}+module Main+  ( main )+where++import qualified Unicode+import qualified Chess++tests :: [(String,String,Chess.Edge)]+tests =+    [("Initial position",+      "rnbqkbnr/pppppppp/8/8/8/8/PPPPPPPP/RNBQKBNR",+      Chess.NoEdge),+     ("Mate in 3",+      "KR6/8/kN4r1/p7/8/8/8/8",+      Chess.SingleEdge),+     ("Mate in 4",+      "8/8/4K3/1BkN4/8/2NpP3/3P4/8",+      Chess.DoubleEdge)]++outputFen :: (String,String,Chess.Edge) -> IO ()+outputFen (s,f,e) =+    do putStrLn (s ++ ":")+       Unicode.encode (Chess.fenToUnicode f e ++ Unicode.newline)++main :: IO ()+main = mapM_ outputFen tests