Permalink
Switch branches/tags
Nothing to show
Find file Copy path
Fetching contributors…
Cannot retrieve contributors at this time
91 lines (68 sloc) 2.53 KB
{-# LANGUAGE OverloadedStrings #-}
module Parser (decode, encode) where
import Control.Applicative ((<|>), Alternative)
import Data.Attoparsec.ByteString
import Data.ByteString (ByteString)
import Data.Monoid ((<>))
import Data.Word (Word8)
import Prelude hiding (or, take, takeWhile)
import Types
decode :: ByteString -> Maybe Message
decode = maybeResult . parse message
encode :: Message -> ByteString
encode (Message Nothing cmd ps) = cmd <> " " <> paramize ps
encode (Message (Just pfx) cmd ps) = ":" <> enc pfx <> " " <> cmd <> " " <> paramize ps
where enc (Server s) = s
enc (User n u h) = n <> maybe "" ("!" <>) u
<> maybe "" ("@" <>) h
paramize :: Params -> ByteString
paramize ps = case ps of
[] -> ""
[x] -> ":" <> x
(x:xs) -> x <> " " <> paramize xs
message :: Parser Message
message = do
p <- prefix
c <- command
ps <- option [] params
-- _ <- crlf
return $ Message p c ps
prefix :: Parser (Maybe Prefix)
prefix = option Nothing . fmap Just $ word8 58 >> nickPrefix <|> serverPrefix
nickPrefix :: Parser Prefix
nickPrefix = do
n <- nick
u <- option Nothing . fmap Just $ word8 33 >> user
h <- option Nothing . fmap Just $ word8 64 >> host
_ <- space
return $ User n u h
serverPrefix :: Parser Prefix
serverPrefix = host >>= (space >>=) . const . return . Server
params :: Parser Params
params = many1 $ space >> (word8 58 >> trailing) <|> middle
command :: Parser ByteString
command = takeWhile1 letter <|> takeWhile1 number
{-
crlf :: Parser ()
crlf = string "\CR\LF" >> return ()
-}
host :: Parser ByteString
host = let good w = w /= 32 && w /= 33 && w /= 64 in takeWhile1 good -- noneOf " @!"
letter :: Word8 -> Bool
letter w = (65 <= w && w <= 90) || (97 <= w && w <= 122) -- oneOf $ ['a'..'z'] <> ['A'..'Z']
middle :: Parser ByteString
middle = takeWhile1 nonWhite
nick :: Parser ByteString
nick = let good w = letter w || number w || special w in takeWhile1 good
nonWhite :: Word8 -> Bool
nonWhite w = w /= 0 && w /= 10 && w /= 13 && w /= 32 -- noneOf "\SP\NUL\CR\LF"
number :: Word8 -> Bool
number w = 48 <= w && w <= 57 -- oneOf ['0'..'9']
space :: Parser ByteString
space = takeWhile1 (== 32) -- many1 $ char '\SP'
special :: Word8 -> Bool
special = inClass "-[]\\`^{}_|"
trailing :: Parser ByteString
trailing = let good w = w /= 0 && w /= 10 && w /= 13 in takeWhile good
user :: Parser ByteString
user = takeWhile1 $ notInClass "\SP\NUL\CR\LF\64"