mcpi 0.0.0.3 → 0.0.0.4
raw patch · 4 files changed
+238/−64 lines, 4 filesdep ~basedep ~transformersnew-component:exe:debugmcpiPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: base, transformers
API changes (from Hackage documentation)
Files
- examples/DebugMCPI.hs +80/−0
- examples/README.md +56/−17
- mcpi.cabal +35/−11
- src/Network/MineCraft/Pi/Client/Internal.hs +67/−36
+ examples/DebugMCPI.hs view
@@ -0,0 +1,80 @@+{-+License:++This code is placed in the Public Domain.++Author:++Douglas Burke (dburke.gw@gmail.com)++Usage:++ ./debugmcpi++Similar to MCPI.hs except that the user input is converted into+a library call. The \"command language\" is++ command name [arg1 .. argn]+ query name [arg1 .. argn]+ quit+ exit++and is case sensitive.++This is to support debugging the interface.++-}++module Main where++import Control.Monad (void)+import Control.Monad.IO.Class++import Data.Char (isSpace)++import Network.MineCraft.Pi.Client.Internal (MCPI, runMCPI', command, query)++import System.Environment (getArgs, getProgName)+import System.Exit (exitFailure, exitSuccess)+import System.IO (hPutStrLn, stderr)++import Utils (printVersion)++-- | Remove leading and trailing whitespace.+strip :: String -> String+strip = reverse . dropWhile isSpace . reverse . dropWhile isSpace+ +-- | Ask the user for a command, execute it and, if necessary, +-- wait for a response.+--+userInteract :: MCPI () +userInteract = do+ user <- liftIO getLine+ handleUser (strip user)+ userInteract+ +-- | For queries I am currently relying on the debug output of+-- @query@ rather than handle the output here.+handleUser :: String -> MCPI ()+handleUser [] = return ()+handleUser "quit" = liftIO $ exitSuccess+handleUser "exit" = liftIO $ exitSuccess+handleUser user = + case words user of+ ("command":comm:args) -> command comm args+ ("query":qry:args) -> void (query qry args)+ _ -> liftIO $ putStrLn "Expected quit, exit, command ..., or query ..."+ +usage :: IO ()+usage = do+ progName <- getProgName+ hPutStrLn stderr $ "Usage: " ++ progName+ exitFailure++main :: IO ()+main = do+ args <- getArgs+ if null args+ then printVersion >> runMCPI' True userInteract+ else usage+
examples/README.md view
@@ -6,9 +6,18 @@ When called with the `--debug` argument the programs will print, to `stderr`, the messages they send to, and receive from, the-MineCraft program. This is true for all the examples except for-`hmcpi`.+MineCraft program. +These programs are built by setting the `build-examples` flag,+which is set by default, so either of the following will work++ cabal configure+ cabal configure -fbuild-examples++To avoid building the programs, use:++ cabal configure -f-build-examples+ freefall -------- @@ -45,6 +54,39 @@ There is no check that the blocks that are added are actually supported, although this could be added by an enterprising programmer. +isongold+--------++Source code: [IsOnGold.hs](https://github.com/DougBurke/hmcpi/blob/master/examples/IsOnGold.hs)++Usage:++ isongold [--debug]++Tells the user to look down if they are standing on a gold ore block.++xjump+-----++Source code: [XJump.hs](https://github.com/DougBurke/hmcpi/blob/master/examples/XJump.hs)++Usage:++ xjump [--debug]++Move the player by 10 tiles in the X direction if the tile is not+filled.++Debug programs+==============++The following are useful when trying to debug the module.++These programs are built by setting the `build-debug` flag,+which is *not* set by default:++ cabal configure -fbuild-debug+ hmcpi ----- @@ -66,25 +108,22 @@ Note that this program does not take use the `mcpi` library, since it is provides a direct connection to the MineCraft-Pi program. -isongold---------+debugmcpi+--------- -Source code: [IsOnGold.hs](https://github.com/DougBurke/hmcpi/blob/master/examples/IsOnGold.hs)+Source code: [DebugMCPI.hs](https://github.com/DougBurke/hmcpi/blob/master/examples/DebugMCPI.hs) Usage: - isongold [--debug]--Tells the user to look down if they are standing on a gold ore block.--xjump--------Source code: [XJump.hs](https://github.com/DougBurke/hmcpi/blob/master/examples/XJump.hs)+ debugmcpi -Usage:+This provides a simple interface for sending commands and queries+to MineCraft. It differs from hmcpi in that you do not talk+directly to MineCraft, instead you have the following commands - xjump [--debug]+ exit+ quit+ command name [arg1 .. argn]+ query name [arg1 .. argn] -Move the player by 10 tiles in the X direction if the tile is not-filled.+Everything is treated as a string.
mcpi.cabal view
@@ -1,5 +1,5 @@ Name: mcpi-Version: 0.0.0.3+Version: 0.0.0.4 Homepage: https://github.com/DougBurke/hmcpi Bug-Reports: https://github.com/DougBurke/hmcpi/issues Stability: experimental@@ -38,6 +38,10 @@ Description: Build the example programs (defaults to True) Default: True +Flag build-debug+ Description: Build programs for debugging the module (defaults to False)+ Default: False+ Library Build-Depends: base >=3 && < 5,@@ -59,6 +63,7 @@ ghc-options: -Wall +-- Examples Executable flatten if !flag(build-examples) Buildable: False@@ -95,11 +100,11 @@ mcpi, transformers -Executable hmcpi+Executable isongold if !flag(build-examples) Buildable: False - Main-Is: HMCPI.hs+ Main-Is: IsOnGold.hs Hs-Source-Dirs: examples/ Other-Modules: Paths_mcpi@@ -110,14 +115,13 @@ Build-Depends: base,- network,- pipes >= 3.0 && < 3.2+ mcpi -Executable isongold+Executable xjump if !flag(build-examples) Buildable: False - Main-Is: IsOnGold.hs+ Main-Is: XJump.hs Hs-Source-Dirs: examples/ Other-Modules: Paths_mcpi@@ -130,11 +134,12 @@ base, mcpi -Executable xjump- if !flag(build-examples)+-- Debug programs+Executable hmcpi+ if !flag(build-debug) Buildable: False - Main-Is: XJump.hs+ Main-Is: HMCPI.hs Hs-Source-Dirs: examples/ Other-Modules: Paths_mcpi@@ -145,4 +150,23 @@ Build-Depends: base,- mcpi+ network,+ pipes >= 3.0 && < 3.2++Executable debugmcpi+ if !flag(build-debug)+ Buildable: False++ Main-Is: DebugMCPI.hs+ Hs-Source-Dirs: examples/ ++ Other-Modules: Paths_mcpi+ Utils++ ghc-options:+ -Wall++ Build-Depends:+ base,+ mcpi,+ transformers
src/Network/MineCraft/Pi/Client/Internal.hs view
@@ -27,12 +27,16 @@ import qualified Control.Exception as CE import Control.Exception (bracket)-import Control.Monad (when)+import Control.Monad (unless, when) import Control.Monad.IO.Class import Control.Monad.Trans.Reader +import Data.Char (isSpace) import Data.List (intercalate) +import Foreign+import Foreign.C.String+ import Network.BSD import Network.Socket @@ -48,6 +52,11 @@ type MCPI = ReaderT ConnInfo IO -- | Connection information.+--+-- /TODO:/ Should the buffer used by @flushChannel@ be stored here, to+-- avoid repeated allocation/de-allocation? It is unlikely (I+-- speculate) to be a major optimisation in time or space.+-- data ConnInfo = ConnInfo { _ciHandle :: Handle -- ^ Connection to the MineCraft program , _ciDebug :: Bool -- ^ Should messages to and from MineCraft@@ -69,8 +78,8 @@ -- /TODO:/ Change the retun value to @Maybe ConnInfo@ and -- make this public. openMCPI ::- Bool -- ^ Set to @True@ to get debugging messages printed to @stderr@.- -> IO ConnInfo+ Bool -- ^ Set to @True@ to get debugging messages printed to @stderr@.+ -> IO ConnInfo openMCPI flag = do let ehdl :: CE.IOException -> IO () ehdl _ = @@ -81,6 +90,7 @@ let a = head as -- note: getAddrInfo never returns an empty list sock <- socket (addrFamily a) Stream defaultProtocol setSocketOption sock KeepAlive 1+ setSocketOption sock NoDelay 1 connect sock (addrAddress a) `CE.catch` ehdl h <- socketToHandle sock ReadWriteMode hSetBuffering h LineBuffering@@ -93,65 +103,86 @@ closeMCPI :: ConnInfo -> IO () closeMCPI = hClose . _ciHandle -logMsg :: ConnInfo -> String -> String -> MCPI ()+-- | Write a debug message to @stderr@ if the debug flag is set. The+-- format is \"[type] msg\".+--+logMsg ::+ ConnInfo+ -> String -- ^ The type of message (ideally 8 characters or less to+ -- keep the output aligned, but can be larger). Trailing+ -- white space is ignored.+ -> String -- ^ The message to display.+ -> IO () logMsg ConnInfo {..} hdr msg = - when _ciDebug $ liftIO $ hPutStrLn stderr + when _ciDebug $ hPutStrLn stderr $ "[" ++ hdr ++ replicate (8 - length hdr) ' ' ++- "] " ++ msg+ "] " ++ reverse (dropWhile isSpace (reverse msg)) --- It might be nice to do the argument marshalling here, i.e. have--- something like @command :: Command -> [Argument] -> MCPI ()@--- which would be run like @command "player.setTile" [Pos 0 0 0]@,--- but I do not want to deal with heterogeneous lists at this time.--- Instead, we force the caller to do the conversion.---+-- | Add arguments to a query or command to create the+-- string to send to MineCraft. addArgs :: String -> [Argument] -> String addArgs a bs = a ++ "(" ++ intercalate "," bs ++ ")" -{-+-- | At present the only "error" message I have seen is "Fail\0",+-- so we use a small buffer size.+bufSize :: Int+bufSize = 16++-- | Return from MineCraft that indicates an error.+connectionError :: String+connectionError = "Fail"+ -- | Remove any output from the handle. A debug message is written -- to let the user know this has happened, presumably because of -- a previous invalid call. The previous call could be stored in -- ConnInfo to make the message more useful, but leave that for now. -- flushChannel :: ConnInfo -> IO ()-flushChannel ConnInfo {..} = do--Hmm, do I need the socket as well as the handle?-- while True:- readable, _, _ = select.select([self.socket], [], [], 0.0)- if not readable:- break- data = self.socket.recv(1500)- e = "Drained Data: <%s>\n"%data.strip()- e += "Last Message: <%s>\n"%self.lastSent.strip()- sys.stderr.write(e)---}+flushChannel ci@ConnInfo {..} = do+ -- Should the buffer be stored in ConnInfo so we don't have+ -- to repeatedly allocate it? It's only small (at present),+ -- so probably not an issue.+ fbuf <- mallocForeignPtrBytes bufSize + withForeignPtr fbuf $ \bufPtr -> + let loop store = do+ nrec <- hGetBufNonBlocking _ciHandle bufPtr bufSize+ if (nrec > 0)+ then peekCStringLen (bufPtr, nrec) >>= \str -> loop (store ++ str)+ else unless (null store) $ logMsg ci "FLUSH" store+ in loop [] --- | Run a MineCraft command. +-- | Run a MineCraft command. command :: Command -> [Argument] -> MCPI () command comm args = do ci <- ask let commstr = addArgs comm args- logMsg ci "COMMAND" commstr- liftIO $ hPutStrLn (_ciHandle ci) commstr+ liftIO $ + flushChannel ci+ >> logMsg ci "COMMAND" commstr+ >> hPutStrLn (_ciHandle ci) commstr --- | Run a MineCraft query, returning the response.+-- | Run a MineCraft query, returning the response. An+-- @IOError@ is raised if the response is @Fail@ (this+-- might be due to a previous command failing, depending+-- on the time taken by MineCraft to respond).+-- query :: Query -> [Argument] -> MCPI String query qry args = do ci <- ask- let qrystr = addArgs qry args- logMsg ci "QUERY" qrystr- liftIO $ hPutStrLn (_ciHandle ci) qrystr+ let qryStr = addArgs qry args+ liftIO $ + flushChannel ci+ >> logMsg ci "QUERY" qryStr+ >> hPutStrLn (_ciHandle ci) qryStr ans <- liftIO $ hGetLine (_ciHandle ci)- logMsg ci "RESPONSE" ans+ liftIO $ logMsg ci "RESPONSE" ans+ when (ans == connectionError) $+ liftIO $ ioError $ userError $ "Query failed: " ++ qryStr return ans -- | Run a Raspberry-PI program. The flag determines whether the -- messages sent to, and received from, the server, are--- printed to @stderr@.+-- printed to @stderr@ as a diagnostic. -- -- An exception is raised if the server is not running, or -- can not be contacted.