diff --git a/haxparse.cabal b/haxparse.cabal --- a/haxparse.cabal +++ b/haxparse.cabal @@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/ name: haxparse -version: 0.2.0.0 +version: 0.3.0.0 synopsis: Readable HaxBall replays description: Provides an interface for parsing HaxBall replays. homepage: https://github.com/joelteon/haxparse @@ -13,6 +13,7 @@ category: Data build-type: Simple cabal-version: >=1.8 +tested-with: GHC == 7.4.2, GHC == 7.6.3 source-repository head type: git @@ -22,46 +23,41 @@ exposed-modules: HaxParse.AST HaxParse.AST.TH HaxParse.Parser - build-depends: base == 4.6.*, - binary == 0.7.*, - bytestring == 0.10.*, - containers == 0.5.*, - data-binary-ieee754 == 0.4.*, - data-default == 0.5.*, - lens == 3.9.*, - optparse-applicative == 0.5.*, - mtl == 2.1.*, - parsec == 3.1.*, - split == 0.2.*, - template-haskell == 2.8.*, - transformers == 0.3.*, - utf8-string == 0.3.*, - zlib == 0.5.* + build-depends: base >= 4.4 && < 4.8, + binary >= 0.7 && < 0.8, + bytestring >= 0.9 && < 0.11, + containers >= 0.4 && < 0.6, + data-binary-ieee754 >= 0.4 && < 0.5, + data-default >= 0.5 && < 0.6, + mtl >= 2.1 && < 2.2, + parsec >= 3.1 && < 3.2, + split >= 0.2 && < 0.3, + template-haskell >= 2.7 && < 2.10, + transformers >= 0.3 && < 0.4, + utf8-string >= 0.3 && < 0.4, + zlib >= 0.5 && < 0.6 hs-source-dirs: src extensions: FlexibleInstances, MultiParamTypeClasses, OverloadedStrings, TemplateHaskell executable haxparse main-is: Main.hs - other-modules: HaxParse.AST.TH - HaxParse.AST - HaxParse.Options + other-modules: HaxParse.Options HaxParse.Output.Plain HaxParse.Output - HaxParse.Parser hs-source-dirs: src - build-depends: base == 4.6.*, - binary == 0.7.*, - bytestring == 0.10.*, - containers == 0.5.*, - data-binary-ieee754 == 0.4.*, - data-default == 0.5.*, - lens == 3.9.*, - optparse-applicative == 0.5.*, - mtl == 2.1.*, - parsec == 3.1.*, - split == 0.2.*, - template-haskell == 2.8.*, - transformers == 0.3.*, - utf8-string == 0.3.*, - zlib == 0.5.* + build-depends: base >= 4.4 && < 4.8, + binary >= 0.7 && < 0.8, + bytestring >= 0.9 && < 0.11, + containers >= 0.4 && < 0.6, + data-binary-ieee754 >= 0.4 && < 0.5, + data-default >= 0.5 && < 0.6, + haxparse, + mtl >= 2.1 && < 2.2, + optparse-applicative >= 0.5 && < 0.6, + parsec >= 3.1 && < 3.2, + split >= 0.2 && < 0.3, + template-haskell >= 2.7 && < 2.10, + transformers >= 0.3 && < 0.4, + utf8-string >= 0.3 && < 0.4, + zlib >= 0.5 && < 0.6 extensions: FlexibleInstances, MultiParamTypeClasses, OverloadedStrings, TemplateHaskell diff --git a/src/HaxParse/Output/Plain.hs b/src/HaxParse/Output/Plain.hs --- a/src/HaxParse/Output/Plain.hs +++ b/src/HaxParse/Output/Plain.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE MultiWayIf #-} {-# OPTIONS_GHC -fno-warn-unused-do-bind #-} module HaxParse.Output.Plain ( @@ -102,9 +101,11 @@ showEv (ChangeAvatar s) p = return $ printf "%s changes avatar to \"%s\"" (toString $ name p) (toString s) showEv (Departure d k b r) p = do ps <- asks snd let n = toString . name $ ps I.! fromIntegral d - if | b -> return $ printf "%s bans %s (%s)" n (toString $ name p) (maybe "no reason" toString r) - | k -> return $ printf "%s kicks %s (%s)" n (toString $ name p) (maybe "no reason" toString r) - | otherwise -> return $ printf "%s leaves" n + if b + then return $ printf "%s bans %s (%s)" n (toString $ name p) (maybe "no reason" toString r) + else if k + then return $ printf "%s kicks %s (%s)" n (toString $ name p) (maybe "no reason" toString r) + else return $ printf "%s leaves" n showEv StopMatch p = return $ printf "%s stops match" (toString $ name p) showEv (TeamChange m t) p = do ps <- asks snd let n = toString . name $ ps I.! fromIntegral m diff --git a/src/HaxParse/Parser.hs b/src/HaxParse/Parser.hs --- a/src/HaxParse/Parser.hs +++ b/src/HaxParse/Parser.hs @@ -5,7 +5,6 @@ import Codec.Compression.Zlib import Control.Applicative ((<$>), (<*>), pure) -import Control.Lens hiding (Action) import Control.Monad import Data.Binary import Data.Binary.Get @@ -24,15 +23,13 @@ import Text.Parsec.Error import Text.Parsec.Prim -data ParserState = ParserState { _frame :: Word32 - , _curDiscId :: Word32 - , _playerList :: I.IntMap Player +data ParserState = ParserState { frame :: Word32 + , curDiscId :: Word32 + , playerList :: I.IntMap Player } instance Default ParserState where def = ParserState 0 0 mempty -makeLenses ''ParserState - type Parser = Parsec C.ByteString ParserState instance (Monad m) => Stream C.ByteString m Char where @@ -58,7 +55,7 @@ players_ count 14 $ char '\NUL' ev <- many event - plist <- fmap (^. playerList) getState + plist <- fmap playerList getState return Replay { version = vers , frameCount = framecount , firstFrame = firstframe @@ -145,8 +142,8 @@ count (fromIntegral s) disc disc :: Parser Disc -disc = do discid <- view curDiscId <$> getState - modifyState (curDiscId +~ 1) +disc = do discid <- curDiscId <$> getState + modifyState (\p -> p { curDiscId = curDiscId p + 1 }) posx <- double posy <- double speedx <- double @@ -213,13 +210,13 @@ , handicap = h , pDiscId = did } - modifyState (playerList %~ I.insert pid p) + modifyState (\st -> st { playerList = I.insert pid p (playerList st) }) event :: Parser Action event = do timeUpdate <- bool "is it a time update?" when timeUpdate $ do frames <- int32 - modifyState (frame +~ frames) - fc <- view frame <$> getState + modifyState (\st -> st { frame = frame st + frames }) + fc <- frame <$> getState pid <- fromIntegral <$> int32 evty <- int8 result <- case evty of 0 -> newPlayer @@ -262,7 +259,7 @@ , handicap = 0 , pDiscId = -1 } - modifyState (playerList %~ I.insert i p) + modifyState (\st -> st { playerList = I.insert i p $ playerList st }) return $ NewPlayer { npId = i , npName = n , npAdmin = ai