    {-# LANGUAGE OverloadedStrings #-}

    module Network.Wai.Application.Classic.Lang (parseLang) where

    import Control.Applicative hiding (optional)
    import Data.Attoparsec.ByteString (Parser, takeWhile, parseOnly)
    import Data.Attoparsec.ByteString.Char8 (char, string, count, space, digit, option, sepBy1)
    import Data.ByteString.Char8 hiding (map, count, take, takeWhile, notElem)
    import Data.List (sortBy)
    import Data.Ord
    import Prelude hiding (takeWhile)

    -- |
    -- >>> parseLang "en-gb;q=0.8, en;q=0.7, da"
    -- ["da","en-gb","en"]

    parseLang :: ByteString -> [ByteString]
    parseLang :: ByteString -> [ByteString]
    parseLang ByteString
    bs = case Parser [(ByteString, Int)]
    -> ByteString -> Either [Char] [(ByteString, Int)]
    forall a. Parser a -> ByteString -> Either [Char] a
    parseOnly Parser [(ByteString, Int)]
    acceptLanguage ByteString
    bs of
        Right [(ByteString, Int)]
    ls -> ((ByteString, Int) -> ByteString)
    -> [(ByteString, Int)] -> [ByteString]
    forall a b. (a -> b) -> [a] -> [b]
    map (ByteString, Int) -> ByteString
    forall a b. (a, b) -> a
    fst ([(ByteString, Int)] -> [ByteString])
    -> [(ByteString, Int)] -> [ByteString]
    forall a b. (a -> b) -> a -> b
    $ ((ByteString, Int) -> (ByteString, Int) -> Ordering)
    -> [(ByteString, Int)] -> [(ByteString, Int)]
    forall a. (a -> a -> Ordering) -> [a] -> [a]
    sortBy (ByteString, Int) -> (ByteString, Int) -> Ordering
    forall {a}. (a, Int) -> (a, Int) -> Ordering
    detrimental [(ByteString, Int)]
    ls
        Either [Char] [(ByteString, Int)]
    _        -> []
      where
        detrimental :: (a, Int) -> (a, Int) -> Ordering
    detrimental = ((a, Int) -> (a, Int) -> Ordering)
    -> (a, Int) -> (a, Int) -> Ordering
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip (((a, Int) -> Int) -> (a, Int) -> (a, Int) -> Ordering
    forall a b. Ord a => (b -> a) -> b -> b -> Ordering
    comparing (a, Int) -> Int
    forall a b. (a, b) -> b
    snd)

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

    acceptLanguage :: Parser [(ByteString,Int)]
    acceptLanguage :: Parser [(ByteString, Int)]
    acceptLanguage = Parser (ByteString, Int)
    rangeQvalue Parser (ByteString, Int)
    -> Parser ByteString () -> Parser [(ByteString, Int)]
    forall (f :: * -> *) a s. Alternative f => f a -> f s -> f [a]
    `sepBy1` (Parser ByteString ()
    spaces Parser ByteString ()
    -> Parser ByteString Char -> Parser ByteString Char
    forall a b.
    Parser ByteString a -> Parser ByteString b -> Parser ByteString b
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
    *> Char -> Parser ByteString Char
    char Char
    ',' Parser ByteString Char
    -> Parser ByteString () -> Parser ByteString ()
    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 ByteString ()
    spaces)

    rangeQvalue :: Parser (ByteString,Int)
    rangeQvalue :: Parser (ByteString, Int)
    rangeQvalue = (,) (ByteString -> Int -> (ByteString, Int))
    -> Parser ByteString ByteString
    -> Parser ByteString (Int -> (ByteString, Int))
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Parser ByteString ByteString
    languageRange Parser ByteString (Int -> (ByteString, Int))
    -> Parser ByteString Int -> Parser (ByteString, Int)
    forall a b.
    Parser ByteString (a -> b)
    -> Parser ByteString a -> Parser ByteString b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Parser ByteString Int
    quality

    languageRange :: Parser ByteString
    languageRange :: Parser ByteString ByteString
    languageRange = (Word8 -> Bool) -> Parser ByteString ByteString
    takeWhile (Word8 -> [Word8] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `notElem` [Word8
    32, Word8
    44, Word8
    59])

    quality :: Parser Int
    quality :: Parser ByteString Int
    quality = Int -> Parser ByteString Int -> Parser ByteString Int
    forall (f :: * -> *) a. Alternative f => a -> f a -> f a
    option Int
    1000 (ByteString -> Parser ByteString ByteString
    string ByteString
    ";q=" Parser ByteString ByteString
    -> Parser ByteString Int -> Parser ByteString Int
    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 ByteString Int
    qvalue)

    qvalue :: Parser Int
    qvalue :: Parser ByteString Int
    qvalue = Int
    1000  Int -> Parser ByteString () -> Parser ByteString Int
    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
    '1' Parser ByteString Char
    -> Parser ByteString () -> Parser ByteString ()
    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 ByteString [Char] -> Parser ByteString ()
    forall {f :: * -> *} {b}. (Alternative f, Monad f) => f b -> f ()
    optional (Char -> Parser ByteString Char
    char Char
    '.' Parser ByteString Char
    -> Parser ByteString [Char] -> Parser ByteString [Char]
    forall a b.
    Parser ByteString a -> Parser ByteString b -> Parser ByteString b
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
    *> Int -> Int -> Parser ByteString Char -> Parser ByteString [Char]
    forall a. Int -> Int -> Parser a -> Parser [a]
    range Int
    0 Int
    3 Parser ByteString Char
    digit))
         Parser ByteString Int
    -> Parser ByteString Int -> Parser ByteString Int
    forall a.
    Parser ByteString a -> Parser ByteString a -> Parser ByteString a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> [Char] -> Int
    forall {c}. Read c => [Char] -> c
    read3 ([Char] -> Int)
    -> Parser ByteString [Char] -> Parser ByteString Int
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (Char -> Parser ByteString Char
    char Char
    '0' Parser ByteString Char
    -> Parser ByteString [Char] -> Parser ByteString [Char]
    forall a b.
    Parser ByteString a -> Parser ByteString b -> Parser ByteString b
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
    *> [Char] -> Parser ByteString [Char] -> Parser ByteString [Char]
    forall (f :: * -> *) a. Alternative f => a -> f a -> f a
    option [Char]
    "0" (Char -> Parser ByteString Char
    char Char
    '.' Parser ByteString Char
    -> Parser ByteString [Char] -> Parser ByteString [Char]
    forall a b.
    Parser ByteString a -> Parser ByteString b -> Parser ByteString b
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
    *> Int -> Int -> Parser ByteString Char -> Parser ByteString [Char]
    forall a. Int -> Int -> Parser a -> Parser [a]
    range Int
    0 Int
    3 Parser ByteString Char
    digit))
      where
        read3 :: [Char] -> c
    read3 [Char]
    n = [Char] -> c
    forall {c}. Read c => [Char] -> c
    read ([Char] -> c) -> ([Char] -> [Char]) -> [Char] -> c
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> [Char] -> [Char]
    forall a. Int -> [a] -> [a]
    take Int
    3 ([Char] -> c) -> [Char] -> c
    forall a b. (a -> b) -> a -> b
    $ [Char]
    n [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Char -> [Char]
    forall a. a -> [a]
    repeat Char
    '0'
        optional :: f b -> f ()
    optional f b
    p = () () -> f b -> f ()
    forall a b. a -> f b -> f a
    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
    <$ f b
    p f () -> f () -> f ()
    forall a. f a -> f a -> f a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> () -> f ()
    forall a. a -> f a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()

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

    range :: Int -> Int -> Parser a -> Parser [a]
    range :: forall a. Int -> Int -> Parser a -> Parser [a]
    range Int
    n Int
    m Parser a
    p = [a] -> [a] -> [a]
    forall a. [a] -> [a] -> [a]
    (++) ([a] -> [a] -> [a])
    -> Parser ByteString [a] -> Parser ByteString ([a] -> [a])
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Int -> Parser a -> Parser ByteString [a]
    forall (m :: * -> *) a. Monad m => Int -> m a -> m [a]
    count Int
    n Parser a
    p Parser ByteString ([a] -> [a])
    -> Parser ByteString [a] -> Parser ByteString [a]
    forall a b.
    Parser ByteString (a -> b)
    -> Parser ByteString a -> Parser ByteString b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Int -> Parser a -> Parser ByteString [a]
    forall a. Int -> Parser a -> Parser [a]
    upto (Int
    m Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    n) Parser a
    p

    upto :: Int -> Parser a -> Parser [a]
    upto :: forall a. Int -> Parser a -> Parser [a]
    upto Int
    0 Parser a
    _ = [a] -> Parser ByteString [a]
    forall a. a -> Parser ByteString a
    forall (m :: * -> *) a. Monad m => a -> m a
    return []
    upto Int
    n Parser a
    p = (:) (a -> [a] -> [a]) -> Parser a -> Parser ByteString ([a] -> [a])
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Parser a
    p Parser ByteString ([a] -> [a])
    -> Parser ByteString [a] -> Parser ByteString [a]
    forall a b.
    Parser ByteString (a -> b)
    -> Parser ByteString a -> Parser ByteString b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Int -> Parser a -> Parser ByteString [a]
    forall a. Int -> Parser a -> Parser [a]
    upto (Int
    n Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1) Parser a
    p Parser ByteString [a]
    -> Parser ByteString [a] -> Parser ByteString [a]
    forall a.
    Parser ByteString a -> Parser ByteString a -> Parser ByteString a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> [a] -> Parser ByteString [a]
    forall a. a -> Parser ByteString a
    forall (m :: * -> *) a. Monad m => a -> m a
    return []

    spaces :: Parser ()
    spaces :: Parser ByteString ()
    spaces = () () -> 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
    <$ Parser ByteString Char -> Parser ByteString [Char]
    forall a. Parser ByteString a -> Parser ByteString [a]
    forall (f :: * -> *) a. Alternative f => f a -> f [a]
    many Parser ByteString Char
    space