module Text.Damn.Packet.Parser (
Packet(..),
parse, parse',
render,
pktSubpacket,
pktSubpacket',
pktSubpacketL
) where
import Prelude hiding (null)
import Control.Applicative ((<$>), (*>), liftA3, pure)
import Control.Arrow (second)
import qualified Data.Attoparsec.Text as A
import Data.Char
import qualified Data.Map as M
import Data.Monoid
import qualified Data.Text as T
import Text.Damn.Packet.Internal
pktSubpacketL :: Functor f => (Maybe Packet -> f (Maybe Packet)) -> Packet -> f Packet
pktSubpacketL afb s = setter s <$> afb (getter s)
where getter = pktSubpacket'
setter pkt m = pkt { pktBody = render <$> m }
pktSubpacket :: Packet -> Either String Packet
pktSubpacket Packet { pktBody = b } =
case b of Nothing -> Left "Parent packet has no body!"
Just pk -> parse pk
pktSubpacket' :: Packet -> Maybe Packet
pktSubpacket' p = case pktSubpacket p of
Right pk -> Just pk
_ -> Nothing
render :: Packet -> T.Text
render (Packet cmd prm args b) =
cmd
<> maybe "" (" " <>) prm
<> M.foldrWithKey
(\k v m -> "\n" <> k <> "=" <> v <> m) "" args
<> maybe "" ("\n\n" <>) b
parse :: T.Text -> Either String Packet
parse str = if T.null body
then packet
else addBody packet
where adjustedStr = accountForLoginSpace str
(header, body) = second (T.drop 2) $ T.breakOn "\n\n" adjustedStr
packet = A.parseOnly headP header
addBody (Right s) = Right $ s { pktBody = Just body }
addBody l = l
parse' :: T.Text -> Maybe Packet
parse' s = case parse s of
Right pk -> Just pk
_ -> Nothing
headP :: A.Parser Packet
headP = do
cmd <- A.takeWhile1 (not . isSpace)
prm <- A.option Nothing paramP
args <- argsP
return $ Packet cmd prm args Nothing
where
paramP = fmap Just (A.char ' ' *> A.takeWhile1 (not . isSpace)) A.<?> "parameter"
argsP = do
ch <- A.option Nothing (Just <$> A.char '\n')
case ch of
Just '\n' -> liftA3 M.insert
(A.takeWhile1 (/= '='))
(A.char '=' >> A.takeWhile (/= '\n'))
argsP
_ -> pure mempty
--e=event
--symbol=~
accountForLoginSpace :: T.Text -> T.Text
accountForLoginSpace s = if "login " `T.isPrefixOf` s
then T.replace "\n\n" "\n" s
else s