{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
module Network.WebSockets.Extensions.Description
( ExtensionParam
, ExtensionDescription (..)
, ExtensionDescriptions
, parseExtensionDescriptions
, encodeExtensionDescriptions
) where
import Control.Applicative ((*>), (<*))
import qualified Data.Attoparsec.ByteString as A
import qualified Data.Attoparsec.ByteString.Char8 as AC8
import qualified Data.ByteString as B
import Data.Monoid (mconcat, mappend)
import Prelude
type ExtensionParam = (B.ByteString, Maybe B.ByteString)
data ExtensionDescription = ExtensionDescription
{ ExtensionDescription -> ByteString
extName :: !B.ByteString
, ExtensionDescription -> [ExtensionParam]
extParams :: ![ExtensionParam]
} deriving (ExtensionDescription -> ExtensionDescription -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ExtensionDescription -> ExtensionDescription -> Bool
$c/= :: ExtensionDescription -> ExtensionDescription -> Bool
== :: ExtensionDescription -> ExtensionDescription -> Bool
$c== :: ExtensionDescription -> ExtensionDescription -> Bool
Eq, Int -> ExtensionDescription -> ShowS
[ExtensionDescription] -> ShowS
ExtensionDescription -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ExtensionDescription] -> ShowS
$cshowList :: [ExtensionDescription] -> ShowS
show :: ExtensionDescription -> String
$cshow :: ExtensionDescription -> String
showsPrec :: Int -> ExtensionDescription -> ShowS
$cshowsPrec :: Int -> ExtensionDescription -> ShowS
Show)
parseExtensionDescription :: A.Parser ExtensionDescription
parseExtensionDescription :: Parser ExtensionDescription
parseExtensionDescription = do
ByteString
extName <- Parser ByteString ByteString
parseIdentifier
[ExtensionParam]
extParams <- forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
A.many' (Char -> Parser ByteString Word8
token Char
';' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString ExtensionParam
parseParam)
forall (m :: * -> *) a. Monad m => a -> m a
return ExtensionDescription {[ExtensionParam]
ByteString
extParams :: [ExtensionParam]
extName :: ByteString
extParams :: [ExtensionParam]
extName :: ByteString
..}
where
parseIdentifier :: Parser ByteString ByteString
parseIdentifier = (Char -> Bool) -> Parser ByteString ByteString
AC8.takeWhile Char -> Bool
isIdentifierChar forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
AC8.skipSpace
token :: Char -> Parser ByteString Word8
token Char
c = Char -> Parser ByteString Word8
AC8.char8 Char
c forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
AC8.skipSpace
isIdentifierChar :: Char -> Bool
isIdentifierChar Char
c =
(Char
c forall a. Ord a => a -> a -> Bool
>= Char
'a' Bool -> Bool -> Bool
&& Char
c forall a. Ord a => a -> a -> Bool
<= Char
'z') Bool -> Bool -> Bool
||
(Char
c forall a. Ord a => a -> a -> Bool
>= Char
'A' Bool -> Bool -> Bool
&& Char
c forall a. Ord a => a -> a -> Bool
<= Char
'Z') Bool -> Bool -> Bool
||
(Char
c forall a. Ord a => a -> a -> Bool
>= Char
'0' Bool -> Bool -> Bool
&& Char
c forall a. Ord a => a -> a -> Bool
<= Char
'9') Bool -> Bool -> Bool
||
Char
c forall a. Eq a => a -> a -> Bool
== Char
'-' Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'_'
parseParam :: A.Parser ExtensionParam
parseParam :: Parser ByteString ExtensionParam
parseParam = do
ByteString
name <- Parser ByteString ByteString
parseIdentifier
Maybe ByteString
val <- forall (f :: * -> *) a. Alternative f => a -> f a -> f a
A.option forall a. Maybe a
Nothing forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Char -> Parser ByteString Word8
token Char
'=' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString ByteString
parseIdentifier
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString
name, Maybe ByteString
val)
encodeExtensionDescription :: ExtensionDescription -> B.ByteString
encodeExtensionDescription :: ExtensionDescription -> ByteString
encodeExtensionDescription ExtensionDescription {[ExtensionParam]
ByteString
extParams :: [ExtensionParam]
extName :: ByteString
extParams :: ExtensionDescription -> [ExtensionParam]
extName :: ExtensionDescription -> ByteString
..} =
forall a. Monoid a => [a] -> a
mconcat (ByteString
extName forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map forall {a}. (Monoid a, IsString a) => (a, Maybe a) -> a
encodeParam [ExtensionParam]
extParams)
where
encodeParam :: (a, Maybe a) -> a
encodeParam (a
key, Maybe a
Nothing) = a
";" forall a. Monoid a => a -> a -> a
`mappend` a
key
encodeParam (a
key, Just a
val) = a
";" forall a. Monoid a => a -> a -> a
`mappend` a
key forall a. Monoid a => a -> a -> a
`mappend` a
"=" forall a. Monoid a => a -> a -> a
`mappend` a
val
type ExtensionDescriptions = [ExtensionDescription]
parseExtensionDescriptions :: B.ByteString -> Either String ExtensionDescriptions
parseExtensionDescriptions :: ByteString -> Either String [ExtensionDescription]
parseExtensionDescriptions = forall a. Parser a -> ByteString -> Either String a
A.parseOnly forall a b. (a -> b) -> a -> b
$
Parser ()
AC8.skipSpace forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>
forall (f :: * -> *) a s. Alternative f => f a -> f s -> f [a]
A.sepBy Parser ExtensionDescription
parseExtensionDescription (Char -> Parser ByteString Word8
AC8.char8 Char
',' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
AC8.skipSpace) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<*
forall t. Chunk t => Parser t ()
A.endOfInput
encodeExtensionDescriptions :: ExtensionDescriptions -> B.ByteString
encodeExtensionDescriptions :: [ExtensionDescription] -> ByteString
encodeExtensionDescriptions = ByteString -> [ByteString] -> ByteString
B.intercalate ByteString
"," forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map ExtensionDescription -> ByteString
encodeExtensionDescription