summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorCamil Staps2017-09-18 12:10:23 +0200
committerCamil Staps2017-09-18 12:10:23 +0200
commitf631863cd01fc1aabf2c90cfd0b1c318a50ba561 (patch)
treee535acb8b3af7e07d54cb549af8f15e319390a5a /src
parentFix typos in assignment1.tex (diff)
parentBasic wrapper (diff)
Merge branch 'wrapper' into 'master'
Basic wrapper See merge request !1
Diffstat (limited to 'src')
-rw-r--r--src/.gitignore3
-rw-r--r--src/Makefile15
-rw-r--r--src/runchess.hs35
3 files changed, 53 insertions, 0 deletions
diff --git a/src/.gitignore b/src/.gitignore
new file mode 100644
index 0000000..c181314
--- /dev/null
+++ b/src/.gitignore
@@ -0,0 +1,3 @@
+*.hi
+*.o
+runchess
diff --git a/src/Makefile b/src/Makefile
new file mode 100644
index 0000000..6e140a1
--- /dev/null
+++ b/src/Makefile
@@ -0,0 +1,15 @@
+EXE:=runchess
+AUX:=$(addsuffix .o,$(EXE)) $(addsuffix .hi,$(EXE))
+GHC:=ghc
+GHCFLAGS:=-O
+
+all: $(EXE)
+
+run: $(EXE)
+ ./$(EXE)
+
+$(EXE): %: %.hs
+ $(GHC) $(GHCFLAGS) $< -o $@
+
+clean:
+ $(RM) $(EXE) $(AUX)
diff --git a/src/runchess.hs b/src/runchess.hs
new file mode 100644
index 0000000..27a6da8
--- /dev/null
+++ b/src/runchess.hs
@@ -0,0 +1,35 @@
+-- vim: sw=2 ts=2 et:
+import Control.Monad
+import Control.Monad.Trans.State.Lazy
+
+import Data.Attoparsec.ByteString.Char8
+import Data.ByteString.Char8 (pack)
+import Data.Maybe
+
+import Chess
+import Chess.FEN
+import Chess.PGN
+
+main = readPGN >>= mapM_ applyPGN
+
+readPGN :: IO [PGN]
+readPGN = do
+ pgn <- pack <$> getContents
+ case parseOnly pgnParser pgn of
+ Left err -> error err
+ Right [] -> error "no games"
+ Right games -> return games
+
+applyPGN :: PGN -> IO ()
+applyPGN pgn = printGame (foldM (flip moveSAN) defaultBoard $ moves pgn) pgn
+
+printGame :: Either MoveError Board -> PGN -> IO ()
+printGame b pgn = printPGN pgn >> printBoard b
+ where
+ printBoard (Left e) = putStrLn $ show e
+ printBoard (Right b) = putStr $ show b
+
+ printPGN :: PGN -> IO ()
+ printPGN pgn = do
+ putStrLn $ site pgn ++ " " ++ date pgn ++ ": " ++ whitePlayer pgn ++ " vs. " ++ blackPlayer pgn
+ putStrLn $ show $ result pgn