damnpacket 0.1.0.0 → 0.1.0.1
raw patch · 4 files changed
+72/−27 lines, 4 filesdep ~basePVP ok
version bump matches the API change (PVP)
Dependency ranges changed: base
API changes (from Hackage documentation)
Files
- benchmarks/parse.hs +29/−18
- damnpacket.cabal +2/−2
- src/Text/Damn/Packet/Internal.hs +8/−0
- src/Text/Damn/Packet/Parser.hs +33/−7
benchmarks/parse.hs view
@@ -1,4 +1,5 @@ {-# OPTIONS_GHC -fno-warn-orphans #-}+{-# OPTIONS_GHC -fno-warn-unused-do-bind #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE StandaloneDeriving #-} @@ -6,24 +7,32 @@ import Criterion.Main import Text.Damn.Packet import Data.Map (fromList)+import Data.Maybe (fromJust) import Data.Monoid import Data.Text (Text) main :: IO () main = do- let mypkt = samplePacket- evaluate mypkt defaultMain [- bench "phony" $ nf parse ""- , bench "cmd" $ nf parse cmd- , bench "cmdParam" $ nf parse cmdParam- , bench "cmdArgs" $ nf parse cmdArgs- , bench "cmdParamArgs" $ nf parse cmdParamArgs- , bench "cmdBody" $ nf parse cmdBody- , bench "cmdParamBody" $ nf parse cmdParamBody- , bench "cmdArgsBody" $ nf parse cmdArgsBody- , bench "cmdParamArgsBody" $ nf parse cmdParamArgsBody- , bench "render" $ nf render mypkt+ bgroup "Parsing" [+ bench "phony" $ nf parse ""+ , bench "cmd" $ nf parse cmd+ , bench "cmdParam" $ nf parse cmdParam+ , bench "cmdArgs" $ nf parse cmdArgs+ , bench "cmdParamArgs" $ nf parse cmdParamArgs+ , bench "cmdBody" $ nf parse cmdBody+ , bench "cmdParamBody" $ nf parse cmdParamBody+ , bench "cmdArgsBody" $ nf parse cmdArgsBody+ , bench "cmdParamArgsBody" $ nf parse cmdParamArgsBody ]+ , bgroup "Rendering" [+ bench "cmd" $ nf render cmdPkt+ , bench "cmdParam" $ nf render cmdParamPkt+ , bench "cmdArgs" $ nf render cmdArgsPkt+ , bench "cmdParamArgs" $ nf render cmdParamArgsPkt+ , bench "cmdBody" $ nf render cmdBodyPkt+ , bench "cmdParamBody" $ nf render cmdParamBodyPkt+ , bench "cmdArgsBody" $ nf render cmdArgsBodyPkt+ , bench "cmdParamArgsBody" $ nf render cmdParamArgsBodyPkt ] ] cmd, cmdParam, cmdArgs, cmdParamArgs,@@ -37,9 +46,11 @@ cmdArgsBody = cmdArgs <> "\n\nfoobar" cmdParamArgsBody = cmdParamArgs <> "\n\nfoobar" -samplePacket :: Packet-samplePacket = Packet { pktCommand = "property"- , pktParameter = Just "chat:WriteRoom"- , pktArgs = fromList [("p", "title"), ("body", "someBody")]- , pktBody = Just "this is the property"- }+cmdPkt = fromJust $! parse' cmd+cmdParamPkt = fromJust $! parse' cmdParam+cmdArgsPkt = fromJust $! parse' cmdArgs+cmdParamArgsPkt = fromJust $! parse' cmdParamArgs+cmdBodyPkt = fromJust $! parse' cmdBody+cmdParamBodyPkt = fromJust $! parse' cmdParamBody+cmdArgsBodyPkt = fromJust $! parse' cmdArgsBody+cmdParamArgsBodyPkt = fromJust $! parse' cmdParamArgsBody
damnpacket.cabal view
@@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/ name: damnpacket-version: 0.1.0.0+version: 0.1.0.1 synopsis: Parsing dAmn packets license: MIT license-file: LICENSE@@ -17,7 +17,7 @@ exposed-modules: Text.Damn.Packet other-modules: Text.Damn.Packet.Internal Text.Damn.Packet.Parser- build-depends: base >= 4.4 && < 4.7+ build-depends: base >= 4.4 && < 4.8 , attoparsec >= 0.10 , containers >= 0.5 , deepseq >= 1.3
src/Text/Damn/Packet/Internal.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE TemplateHaskell #-}@@ -17,13 +18,16 @@ import Data.Data import Data.Map (Map) import Data.Text (Text)+#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ < 707 import Data.Typeable (Typeable)+#endif -- | A type synonym--because pressing spacebar is pretty irritating. type Arguments = Map Text Text lens :: Functor f => (s -> a) -> (s -> b -> t) -> (a -> f b) -> s -> f t lens sa sbt afb s = sbt s <$> afb (sa s)+{-# INLINE lens #-} -- | Represents a dAmn packet. --@@ -70,21 +74,25 @@ => (Text -> f Text) -> Packet -> f Packet pktCommandL = lens pktCommand (\pk b -> pk { pktCommand = b })+{-# INLINE pktCommandL #-} -- | A lens on 'pktParameter'. pktParameterL :: Functor f => (Maybe Text -> f (Maybe Text)) -> Packet -> f Packet pktParameterL = lens pktParameter (\pk b -> pk { pktParameter = b })+{-# INLINE pktParameterL #-} -- | A lens on 'pktArgs'. pktArgsL :: Functor f => (Arguments -> f Arguments) -> Packet -> f Packet pktArgsL = lens pktArgs (\pk b -> pk { pktArgs = b })+{-# INLINE pktArgsL #-} -- | A lens on 'pktBody'. pktBodyL :: Functor f => (Maybe Text -> f (Maybe Text)) -> Packet -> f Packet pktBodyL = lens pktBody (\pk b -> pk { pktBody = b })+{-# INLINE pktBodyL #-}
src/Text/Damn/Packet/Parser.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes #-} @@ -12,11 +13,15 @@ ) where import Prelude hiding (null)-import Control.Applicative ((<$>), (<*>), (*>), many)+import Control.Applicative ((<$>), (*>), liftA3, pure+#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ < 707+ , (<*>), many+#endif+ ) import Control.Arrow (second) import Data.Attoparsec.Text hiding (parse) import Data.Char-import Data.Map (fromList, toList)+import qualified Data.Map as M import Data.Monoid import Data.Text (Text) import qualified Data.Text as T@@ -27,6 +32,7 @@ pktSubpacketL afb s = setter s <$> afb (getter s) where getter p = pktSubpacket' p setter pkt m = pkt { pktBody = render <$> m }+{-# INLINE pktSubpacketL #-} -- | Due to the way dAmn packets are designed, it's not possible to -- unambiguously determine whether a packet has a subpacket or just a body.@@ -51,8 +57,9 @@ render (Packet cmd prm args b) = cmd <> maybe "" (" " <>) prm- <> T.concat (map (\(k,v) -> "\n" <> k <> "=" <> v) (toList args))+ <> M.foldrWithKey (\k v m -> "\n" <> k <> "=" <> v <> m) "" args <> maybe "" ("\n\n" <>) b+{-# INLINE render #-} -- | Parse some text, providing a packet or the reason for parse failure. parse :: Text -> Either String Packet@@ -76,15 +83,34 @@ headP = do cmd <- takeWhile1 (not . isSpace) prm <- option Nothing paramP- args <- fromList <$> argsP+ args <- argsP return $ Packet cmd prm args Nothing where paramP = fmap Just (char ' ' *> takeWhile1 (not . isSpace)) <?> "parameter"- argsP = many ((,) <$> (char '\n' >> takeTill (=='='))- <*> (char '=' >> takeTill (=='\n')))- <?> "arguments"+ argsP = do+ ch <- peekChar+ case ch of+ Just '\n' -> liftA3 M.insert+ (char '\n' >> takeTill (=='='))+ (char '=' >> takeTill (=='\n'))+ argsP+ _ -> pure mempty +-- | The login packet looks like this:+--+-- @+--login username+--e=event+--+--symbol=~+--realname=Some Name+-- @+--+-- That is, with an extra space after the \"event\" argument. Since this is+-- unintuitive behavior and no other packet behaves this way, the parser has+-- a special case for login packets where it will eliminate the extra newline. accountForLoginSpace :: Text -> Text accountForLoginSpace s = if "login " `T.isPrefixOf` s then T.replace "\n\n" "\n" s else s+{-# INLINE accountForLoginSpace #-}