{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}

module Airship.Internal.Parsers
    ( parseEtag
    , parseEtagList
    ) where

import Prelude hiding (takeWhile)

#if __GLASGOW_HASKELL__ < 710
import Control.Applicative ((<$>), (<|>), (*>), (<*))
#else
import Control.Applicative ((<|>))
#endif
import Data.Attoparsec.ByteString.Char8 (Parser, parseOnly, sepBy', char,
                                         string, takeWhile,
                                         takeWhile1, inClass, endOfInput)
import Data.ByteString (ByteString)

import Airship.Types (ETag(..))

comma :: Parser Char
comma :: Parser Char
comma = Char -> Parser Char
char Char
','

doubleQuote :: Char
doubleQuote :: Char
doubleQuote = Char
'"'

insideQuotes :: Parser a -> Parser a
insideQuotes :: Parser a -> Parser a
insideQuotes Parser a
a = Char -> Parser Char
char Char
doubleQuote Parser Char -> Parser a -> Parser a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser a
a Parser a -> Parser Char -> Parser a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser Char
char Char
doubleQuote

optionalWhitespace :: Parser ByteString
optionalWhitespace :: Parser ByteString
optionalWhitespace = (Char -> Bool) -> Parser ByteString
takeWhile (String -> Char -> Bool
inClass String
" \t")

insideWhitespace :: Parser a -> Parser a
insideWhitespace :: Parser a -> Parser a
insideWhitespace Parser a
a = Parser ByteString
optionalWhitespace Parser ByteString -> Parser a -> Parser a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser a
a Parser a -> Parser ByteString -> Parser a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString
optionalWhitespace

weakETag :: Parser ETag
weakETag :: Parser ETag
weakETag = ByteString -> ETag
Weak (ByteString -> ETag) -> Parser ByteString -> Parser ETag
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ByteString -> Parser ByteString
string ByteString
"W/" Parser ByteString -> Parser ByteString -> Parser ByteString
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString -> Parser ByteString
forall a. Parser a -> Parser a
insideQuotes Parser ByteString
rest)
    where rest :: Parser ByteString
rest = (Char -> Bool) -> Parser ByteString
takeWhile1 (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
doubleQuote)

strongETag :: Parser ETag
strongETag :: Parser ETag
strongETag = Parser ETag -> Parser ETag
forall a. Parser a -> Parser a
insideQuotes Parser ETag
strong
    where strong :: Parser ETag
strong = ByteString -> ETag
Strong (ByteString -> ETag) -> Parser ByteString -> Parser ETag
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Bool) -> Parser ByteString
takeWhile1 (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
doubleQuote)

eTag :: Parser ETag
eTag :: Parser ETag
eTag = Parser ETag -> Parser ETag
forall a. Parser a -> Parser a
insideWhitespace (Parser ETag
weakETag Parser ETag -> Parser ETag -> Parser ETag
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ETag
strongETag)

parseEtag :: ByteString -> Maybe ETag
parseEtag :: ByteString -> Maybe ETag
parseEtag ByteString
input = (String -> Maybe ETag)
-> (ETag -> Maybe ETag) -> Either String ETag -> Maybe ETag
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe ETag -> String -> Maybe ETag
forall a b. a -> b -> a
const Maybe ETag
forall a. Maybe a
Nothing) ETag -> Maybe ETag
forall a. a -> Maybe a
Just (Parser ETag -> ByteString -> Either String ETag
forall a. Parser a -> ByteString -> Either String a
parseOnly Parser ETag
eTagToEnd ByteString
input)
    where eTagToEnd :: Parser ETag
eTagToEnd = Parser ETag
eTag Parser ETag -> Parser ByteString () -> Parser ETag
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString ()
forall t. Chunk t => Parser t ()
endOfInput

-- | Parse a list of Etags, returning an empty list if parsing fails
parseEtagList :: ByteString -> [ETag]
parseEtagList :: ByteString -> [ETag]
parseEtagList ByteString
input = (String -> [ETag])
-> ([ETag] -> [ETag]) -> Either String [ETag] -> [ETag]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ([ETag] -> String -> [ETag]
forall a b. a -> b -> a
const []) [ETag] -> [ETag]
forall a. a -> a
id Either String [ETag]
parseResult
    where parseResult :: Either String [ETag]
parseResult = Parser [ETag] -> ByteString -> Either String [ETag]
forall a. Parser a -> ByteString -> Either String a
parseOnly Parser [ETag]
eTagList ByteString
input
          eTagList :: Parser [ETag]
eTagList = (Parser ETag
eTag Parser ETag -> Parser Char -> Parser [ETag]
forall (m :: * -> *) a s. MonadPlus m => m a -> m s -> m [a]
`sepBy'` Parser Char
comma) Parser [ETag] -> Parser ByteString () -> Parser [ETag]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString ()
forall t. Chunk t => Parser t ()
endOfInput