    {-# LANGUAGE OverloadedStrings #-}

    module Network.HTTP.Date.Parser (parseHTTPDate) where

    import Control.Applicative
    import Control.Monad
    import Data.Attoparsec.ByteString
    import Data.Attoparsec.ByteString.Char8
    import Data.ByteString
    import Data.Char
    import Network.HTTP.Date.Types

    ----------------------------------------------------------------

    -- |
    -- Parsing HTTP Date. Currently only RFC1123 style is supported.
    --
    -- >>> parseHTTPDate "Tue, 15 Nov 1994 08:12:31 GMT"
    -- Just (HTTPDate {hdYear = 1994, hdMonth = 11, hdDay = 15, hdHour = 8, hdMinute = 12, hdSecond = 31, hdWkday = 2})

    parseHTTPDate :: ByteString -> Maybe HTTPDate
    parseHTTPDate :: ByteString -> Maybe HTTPDate
    parseHTTPDate ByteString
    bs = case Parser HTTPDate -> ByteString -> Either String HTTPDate
    forall a. Parser a -> ByteString -> Either String a
    parseOnly Parser HTTPDate
    rfc1123Date ByteString
    bs of
        Right HTTPDate
    ut -> HTTPDate -> Maybe HTTPDate
    forall a. a -> Maybe a
    Just HTTPDate
    ut
        Either String HTTPDate
    _        -> Maybe HTTPDate
    forall a. Maybe a
    Nothing

    rfc1123Date :: Parser HTTPDate
    rfc1123Date :: Parser HTTPDate
    rfc1123Date = do
        w <- Parser Int
    wkday
        void $ string ", "
        (y,m,d) <- date1
        sp
        (h,n,s) <- time
        sp
        -- RFC 2616 defines GMT only but there are actually ill-formed ones such
        -- as "+0000" and "UTC" in the wild.
        void $ string "GMT" <|> string "+0000" <|> string "UTC"
        return $ defaultHTTPDate {
            hdYear   = y
          , hdMonth  = m
          , hdDay    = d
          , hdHour   = h
          , hdMinute = n
          , hdSecond = s
          , hdWkday  = w
          }

    wkday :: Parser Int
    wkday :: Parser Int
    wkday = Int
    1 Int -> Parser ByteString ByteString -> Parser Int
    forall a b. a -> Parser ByteString b -> Parser ByteString a
    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
    <$ ByteString -> Parser ByteString ByteString
    string ByteString
    "Mon"
        Parser Int -> Parser Int -> Parser Int
    forall a.
    Parser ByteString a -> Parser ByteString a -> Parser ByteString a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> Int
    2 Int -> Parser ByteString ByteString -> Parser Int
    forall a b. a -> Parser ByteString b -> Parser ByteString a
    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
    <$ ByteString -> Parser ByteString ByteString
    string ByteString
    "Tue"
        Parser Int -> Parser Int -> Parser Int
    forall a.
    Parser ByteString a -> Parser ByteString a -> Parser ByteString a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> Int
    3 Int -> Parser ByteString ByteString -> Parser Int
    forall a b. a -> Parser ByteString b -> Parser ByteString a
    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
    <$ ByteString -> Parser ByteString ByteString
    string ByteString
    "Wed"
        Parser Int -> Parser Int -> Parser Int
    forall a.
    Parser ByteString a -> Parser ByteString a -> Parser ByteString a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> Int
    4 Int -> Parser ByteString ByteString -> Parser Int
    forall a b. a -> Parser ByteString b -> Parser ByteString a
    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
    <$ ByteString -> Parser ByteString ByteString
    string ByteString
    "Thu"
        Parser Int -> Parser Int -> Parser Int
    forall a.
    Parser ByteString a -> Parser ByteString a -> Parser ByteString a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> Int
    5 Int -> Parser ByteString ByteString -> Parser Int
    forall a b. a -> Parser ByteString b -> Parser ByteString a
    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
    <$ ByteString -> Parser ByteString ByteString
    string ByteString
    "Fri"
        Parser Int -> Parser Int -> Parser Int
    forall a.
    Parser ByteString a -> Parser ByteString a -> Parser ByteString a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> Int
    6 Int -> Parser ByteString ByteString -> Parser Int
    forall a b. a -> Parser ByteString b -> Parser ByteString a
    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
    <$ ByteString -> Parser ByteString ByteString
    string ByteString
    "Sat"
        Parser Int -> Parser Int -> Parser Int
    forall a.
    Parser ByteString a -> Parser ByteString a -> Parser ByteString a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> Int
    7 Int -> Parser ByteString ByteString -> Parser Int
    forall a b. a -> Parser ByteString b -> Parser ByteString a
    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
    <$ ByteString -> Parser ByteString ByteString
    string ByteString
    "Sun"

    date1 :: Parser (Int,Int,Int)
    date1 :: Parser (Int, Int, Int)
    date1 = do
        d <- Parser Int
    day
        sp
        m <- month
        sp
        y <- year
        return (y,m,d)
     where
       day :: Parser Int
    day = Parser Int
    digit2
       year :: Parser Int
    year = Parser Int
    digit4

    sp :: Parser ()
    sp :: Parser ByteString ()
    sp = () () -> Parser ByteString Char -> Parser ByteString ()
    forall a b. a -> Parser ByteString b -> Parser ByteString a
    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
    <$ Char -> Parser ByteString Char
    char Char
    ' '

    time :: Parser (Int,Int,Int)
    time :: Parser (Int, Int, Int)
    time = do
        h <- Parser Int
    digit2
        void $ char ':'
        m <- digit2
        void $ char ':'
        s <- digit2
        return (h,m,s)

    month :: Parser Int
    month :: Parser Int
    month =  Int
    1 Int -> Parser ByteString ByteString -> Parser Int
    forall a b. a -> Parser ByteString b -> Parser ByteString a
    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
    <$ ByteString -> Parser ByteString ByteString
    string ByteString
    "Jan"
        Parser Int -> Parser Int -> Parser Int
    forall a.
    Parser ByteString a -> Parser ByteString a -> Parser ByteString a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|>  Int
    2 Int -> Parser ByteString ByteString -> Parser Int
    forall a b. a -> Parser ByteString b -> Parser ByteString a
    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
    <$ ByteString -> Parser ByteString ByteString
    string ByteString
    "Feb"
        Parser Int -> Parser Int -> Parser Int
    forall a.
    Parser ByteString a -> Parser ByteString a -> Parser ByteString a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|>  Int
    3 Int -> Parser ByteString ByteString -> Parser Int
    forall a b. a -> Parser ByteString b -> Parser ByteString a
    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
    <$ ByteString -> Parser ByteString ByteString
    string ByteString
    "Mar"
        Parser Int -> Parser Int -> Parser Int
    forall a.
    Parser ByteString a -> Parser ByteString a -> Parser ByteString a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|>  Int
    4 Int -> Parser ByteString ByteString -> Parser Int
    forall a b. a -> Parser ByteString b -> Parser ByteString a
    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
    <$ ByteString -> Parser ByteString ByteString
    string ByteString
    "Apr"
        Parser Int -> Parser Int -> Parser Int
    forall a.
    Parser ByteString a -> Parser ByteString a -> Parser ByteString a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|>  Int
    5 Int -> Parser ByteString ByteString -> Parser Int
    forall a b. a -> Parser ByteString b -> Parser ByteString a
    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
    <$ ByteString -> Parser ByteString ByteString
    string ByteString
    "May"
        Parser Int -> Parser Int -> Parser Int
    forall a.
    Parser ByteString a -> Parser ByteString a -> Parser ByteString a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|>  Int
    6 Int -> Parser ByteString ByteString -> Parser Int
    forall a b. a -> Parser ByteString b -> Parser ByteString a
    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
    <$ ByteString -> Parser ByteString ByteString
    string ByteString
    "Jun"
        Parser Int -> Parser Int -> Parser Int
    forall a.
    Parser ByteString a -> Parser ByteString a -> Parser ByteString a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|>  Int
    7 Int -> Parser ByteString ByteString -> Parser Int
    forall a b. a -> Parser ByteString b -> Parser ByteString a
    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
    <$ ByteString -> Parser ByteString ByteString
    string ByteString
    "Jul"
        Parser Int -> Parser Int -> Parser Int
    forall a.
    Parser ByteString a -> Parser ByteString a -> Parser ByteString a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|>  Int
    8 Int -> Parser ByteString ByteString -> Parser Int
    forall a b. a -> Parser ByteString b -> Parser ByteString a
    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
    <$ ByteString -> Parser ByteString ByteString
    string ByteString
    "Aug"
        Parser Int -> Parser Int -> Parser Int
    forall a.
    Parser ByteString a -> Parser ByteString a -> Parser ByteString a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|>  Int
    9 Int -> Parser ByteString ByteString -> Parser Int
    forall a b. a -> Parser ByteString b -> Parser ByteString a
    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
    <$ ByteString -> Parser ByteString ByteString
    string ByteString
    "Sep"
        Parser Int -> Parser Int -> Parser Int
    forall a.
    Parser ByteString a -> Parser ByteString a -> Parser ByteString a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> Int
    10 Int -> Parser ByteString ByteString -> Parser Int
    forall a b. a -> Parser ByteString b -> Parser ByteString a
    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
    <$ ByteString -> Parser ByteString ByteString
    string ByteString
    "Oct"
        Parser Int -> Parser Int -> Parser Int
    forall a.
    Parser ByteString a -> Parser ByteString a -> Parser ByteString a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> Int
    11 Int -> Parser ByteString ByteString -> Parser Int
    forall a b. a -> Parser ByteString b -> Parser ByteString a
    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
    <$ ByteString -> Parser ByteString ByteString
    string ByteString
    "Nov"
        Parser Int -> Parser Int -> Parser Int
    forall a.
    Parser ByteString a -> Parser ByteString a -> Parser ByteString a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> Int
    12 Int -> Parser ByteString ByteString -> Parser Int
    forall a b. a -> Parser ByteString b -> Parser ByteString a
    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
    <$ ByteString -> Parser ByteString ByteString
    string ByteString
    "Dec"

    digit2 :: Parser Int
    digit2 :: Parser Int
    digit2 = do
        x1 <- Char -> Int
    toInt (Char -> Int) -> Parser ByteString Char -> Parser Int
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Parser ByteString Char
    digit
        x2 <- toInt <$> digit
        return $ x1 * 10 + x2

    digit4 :: Parser Int
    digit4 :: Parser Int
    digit4 = do
        x1 <- Char -> Int
    toInt (Char -> Int) -> Parser ByteString Char -> Parser Int
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Parser ByteString Char
    digit
        x2 <- toInt <$> digit
        x3 <- toInt <$> digit
        x4 <- toInt <$> digit
        return $ x1 * 1000 + x2 * 100 + x3 * 10 + x4

    toInt :: Char -> Int
    toInt :: Char -> Int
    toInt Char
    c = Char -> Int
    ord Char
    c Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Char -> Int
    ord Char
    '0'