    -- | Code for parsing extensions headers.
    {-# 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
    (ExtensionDescription -> ExtensionDescription -> Bool)
    -> (ExtensionDescription -> ExtensionDescription -> Bool)
    -> Eq ExtensionDescription
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: ExtensionDescription -> ExtensionDescription -> Bool
    == :: ExtensionDescription -> ExtensionDescription -> Bool
    $c/= :: ExtensionDescription -> ExtensionDescription -> Bool
    /= :: ExtensionDescription -> ExtensionDescription -> Bool
    Eq, Int -> ExtensionDescription -> ShowS
    [ExtensionDescription] -> ShowS
    ExtensionDescription -> String
    (Int -> ExtensionDescription -> ShowS)
    -> (ExtensionDescription -> String)
    -> ([ExtensionDescription] -> ShowS)
    -> Show ExtensionDescription
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> ExtensionDescription -> ShowS
    showsPrec :: Int -> ExtensionDescription -> ShowS
    $cshow :: ExtensionDescription -> String
    show :: ExtensionDescription -> String
    $cshowList :: [ExtensionDescription] -> ShowS
    showList :: [ExtensionDescription] -> ShowS
    Show)

    parseExtensionDescription :: A.Parser ExtensionDescription
    parseExtensionDescription :: Parser ExtensionDescription
    parseExtensionDescription = do
        extName   <- Parser ByteString ByteString
    parseIdentifier
        extParams <- A.many' (token ';' *> parseParam)
        return ExtensionDescription {..}
      where
        parseIdentifier :: Parser ByteString ByteString
    parseIdentifier = (Char -> Bool) -> Parser ByteString ByteString
    AC8.takeWhile Char -> Bool
    isIdentifierChar Parser ByteString ByteString
    -> Parser ByteString () -> Parser ByteString ByteString
    forall a b.
    Parser ByteString a -> Parser ByteString b -> Parser ByteString a
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
    <* Parser ByteString ()
    AC8.skipSpace

        token :: Char -> Parser ByteString Word8
    token Char
    c = Char -> Parser ByteString Word8
    AC8.char8 Char
    c Parser ByteString Word8
    -> Parser ByteString () -> Parser ByteString Word8
    forall a b.
    Parser ByteString a -> Parser ByteString b -> Parser ByteString a
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
    <* Parser ByteString ()
    AC8.skipSpace

        isIdentifierChar :: Char -> Bool
    isIdentifierChar Char
    c =
            (Char
    c Char -> Char -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Char
    'a' Bool -> Bool -> Bool
    && Char
    c Char -> Char -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Char
    'z') Bool -> Bool -> Bool
    ||
            (Char
    c Char -> Char -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Char
    'A' Bool -> Bool -> Bool
    && Char
    c Char -> Char -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Char
    'Z') Bool -> Bool -> Bool
    ||
            (Char
    c Char -> Char -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Char
    '0' Bool -> Bool -> Bool
    && Char
    c Char -> Char -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Char
    '9') Bool -> Bool -> Bool
    ||
            Char
    c Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    '-' Bool -> Bool -> Bool
    || Char
    c Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    '_'

        parseParam :: A.Parser ExtensionParam
        parseParam :: Parser ByteString ExtensionParam
    parseParam = do
            name <- Parser ByteString ByteString
    parseIdentifier
            val  <- A.option Nothing $ fmap Just $ token '=' *> parseIdentifier
            return (name, val)

    encodeExtensionDescription :: ExtensionDescription -> B.ByteString
    encodeExtensionDescription :: ExtensionDescription -> ByteString
    encodeExtensionDescription ExtensionDescription {[ExtensionParam]
    ByteString
    extName :: ExtensionDescription -> ByteString
    extParams :: ExtensionDescription -> [ExtensionParam]
    extName :: ByteString
    extParams :: [ExtensionParam]
    ..} =
        [ByteString] -> ByteString
    forall a. Monoid a => [a] -> a
    mconcat (ByteString
    extName ByteString -> [ByteString] -> [ByteString]
    forall a. a -> [a] -> [a]
    : (ExtensionParam -> ByteString) -> [ExtensionParam] -> [ByteString]
    forall a b. (a -> b) -> [a] -> [b]
    map ExtensionParam -> ByteString
    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
    ";" a -> a -> a
    forall a. Monoid a => a -> a -> a
    `mappend` a
    key
        encodeParam (a
    key, Just a
    val) = a
    ";" a -> a -> a
    forall a. Monoid a => a -> a -> a
    `mappend` a
    key a -> a -> a
    forall a. Monoid a => a -> a -> a
    `mappend` a
    "=" a -> a -> 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 = Parser [ExtensionDescription]
    -> ByteString -> Either String [ExtensionDescription]
    forall a. Parser a -> ByteString -> Either String a
    A.parseOnly (Parser [ExtensionDescription]
     -> ByteString -> Either String [ExtensionDescription])
    -> Parser [ExtensionDescription]
    -> ByteString
    -> Either String [ExtensionDescription]
    forall a b. (a -> b) -> a -> b
    $
        Parser ByteString ()
    AC8.skipSpace Parser ByteString ()
    -> Parser [ExtensionDescription] -> Parser [ExtensionDescription]
    forall a b.
    Parser ByteString a -> Parser ByteString b -> Parser ByteString b
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
    *>
        Parser ExtensionDescription
    -> Parser ByteString Word8 -> Parser [ExtensionDescription]
    forall (f :: * -> *) a s. Alternative f => f a -> f s -> f [a]
    A.sepBy Parser ExtensionDescription
    parseExtensionDescription (Char -> Parser ByteString Word8
    AC8.char8 Char
    ',' Parser ByteString Word8
    -> Parser ByteString () -> Parser ByteString Word8
    forall a b.
    Parser ByteString a -> Parser ByteString b -> Parser ByteString a
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
    <* Parser ByteString ()
    AC8.skipSpace) Parser [ExtensionDescription]
    -> Parser ByteString () -> Parser [ExtensionDescription]
    forall a b.
    Parser ByteString a -> Parser ByteString b -> Parser ByteString a
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
    <*
        Parser ByteString ()
    forall t. Chunk t => Parser t ()
    A.endOfInput

    encodeExtensionDescriptions :: ExtensionDescriptions -> B.ByteString
    encodeExtensionDescriptions :: [ExtensionDescription] -> ByteString
    encodeExtensionDescriptions = ByteString -> [ByteString] -> ByteString
    B.intercalate ByteString
    "," ([ByteString] -> ByteString)
    -> ([ExtensionDescription] -> [ByteString])
    -> [ExtensionDescription]
    -> ByteString
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (ExtensionDescription -> ByteString)
    -> [ExtensionDescription] -> [ByteString]
    forall a b. (a -> b) -> [a] -> [b]
    map ExtensionDescription -> ByteString
    encodeExtensionDescription