    {- |
       Module      :  Text.Parsec.Rfc2234
       Copyright   :  (c) 2007-2019 Peter Simons
       License     :  BSD3

       Maintainer  :  simons@cryp.to
       Stability   :  provisional
       Portability :  portable

       This module provides parsers for the grammar defined in
       RFC2234, \"Augmented BNF for Syntax Specifications:
       ABNF\", <http://www.faqs.org/rfcs/rfc2234.html>. The
       terminal called @char@ in the RFC is called 'character'
       here to avoid conflicts with Parsec's 'char' function.
     -}

    {-# LANGUAGE FlexibleContexts #-}

    module Text.Parsec.Rfc2234
      ( caseChar, caseString
      , manyN, manyNtoM
      , alpha, bit, character, cr, lf, crlf, ctl, dquote, hexdig
      , htab, lwsp, octet, sp, vchar, wsp
      , quoted_pair, quoted_string
      ) where

    import Control.Monad ( liftM2, replicateM )
    import Data.Char ( toUpper, chr, ord )
    import Text.Parsec hiding ( crlf )

    -- Customize hlint ...
    {-# ANN module "HLint: ignore Use camelCase" #-}

    ----------------------------------------------------------------------
    -- * Parser Combinators
    ----------------------------------------------------------------------

    -- | Case-insensitive variant of Parsec's 'char' function.

    caseChar :: Stream s m Char => Char -> ParsecT s u m Char
    caseChar :: forall s (m :: * -> *) u.
    Stream s m Char =>
    Char -> ParsecT s u m Char
    caseChar Char
    c = (Char -> Bool) -> ParsecT s u m Char
    forall s (m :: * -> *) u.
    Stream s m Char =>
    (Char -> Bool) -> ParsecT s u m Char
    satisfy (\Char
    x -> Char -> Char
    toUpper Char
    x Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char -> Char
    toUpper Char
    c)

    -- | Case-insensitive variant of Parsec's 'string' function.

    caseString :: Stream s m Char => String -> ParsecT s u m ()
    caseString :: forall s (m :: * -> *) u.
    Stream s m Char =>
    String -> ParsecT s u m ()
    caseString String
    cs = (Char -> ParsecT s u m Char) -> String -> ParsecT s u m ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ Char -> ParsecT s u m Char
    forall s (m :: * -> *) u.
    Stream s m Char =>
    Char -> ParsecT s u m Char
    caseChar String
    cs ParsecT s u m () -> String -> ParsecT s u m ()
    forall s u (m :: * -> *) a.
    ParsecT s u m a -> String -> ParsecT s u m a
    <?> String
    cs

    -- | Match a parser at least @n@ times.

    manyN :: Int -> ParsecT s u m a -> ParsecT s u m [a]
    manyN :: forall s u (m :: * -> *) a.
    Int -> ParsecT s u m a -> ParsecT s u m [a]
    manyN Int
    n ParsecT s u m a
    p | Int
    n Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int
    0    = [a] -> ParsecT s u m [a]
    forall a. a -> ParsecT s u m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return []
              | Bool
    otherwise = ([a] -> [a] -> [a])
    -> ParsecT s u m [a] -> ParsecT s u m [a] -> ParsecT s u m [a]
    forall (m :: * -> *) a1 a2 r.
    Monad m =>
    (a1 -> a2 -> r) -> m a1 -> m a2 -> m r
    liftM2 [a] -> [a] -> [a]
    forall a. [a] -> [a] -> [a]
    (++) (Int -> ParsecT s u m a -> ParsecT s u m [a]
    forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
    replicateM Int
    n ParsecT s u m a
    p) (ParsecT s u m a -> ParsecT s u m [a]
    forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
    many ParsecT s u m a
    p)

    -- | Match a parser at least @n@ times, but no more than @m@ times.

    manyNtoM :: Int -> Int -> ParsecT s u m a -> ParsecT s u m [a]
    manyNtoM :: forall s u (m :: * -> *) a.
    Int -> Int -> ParsecT s u m a -> ParsecT s u m [a]
    manyNtoM Int
    n Int
    m ParsecT s u m a
    p
      | Int
    n Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    0     = [a] -> ParsecT s u m [a]
    forall a. a -> ParsecT s u m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return []
      | Int
    n Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    m     = [a] -> ParsecT s u m [a]
    forall a. a -> ParsecT s u m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return []
      | Int
    n Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    m    = Int -> ParsecT s u m a -> ParsecT s u m [a]
    forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
    replicateM Int
    n ParsecT s u m a
    p
      | Int
    n Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    0    = (Int -> ParsecT s u m [a] -> ParsecT s u m [a])
    -> ParsecT s u m [a] -> [Int] -> ParsecT s u m [a]
    forall a b. (a -> b -> b) -> b -> [a] -> b
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr (ParsecT s u m [a] -> ParsecT s u m [a] -> ParsecT s u m [a]
    forall s u (m :: * -> *) a.
    ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
    (<|>) (ParsecT s u m [a] -> ParsecT s u m [a] -> ParsecT s u m [a])
    -> (Int -> ParsecT s u m [a])
    -> Int
    -> ParsecT s u m [a]
    -> ParsecT s u m [a]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (\Int
    x -> ParsecT s u m [a] -> ParsecT s u m [a]
    forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
    try (Int -> ParsecT s u m a -> ParsecT s u m [a]
    forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
    replicateM Int
    x ParsecT s u m a
    p))) ([a] -> ParsecT s u m [a]
    forall a. a -> ParsecT s u m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return []) ([Int] -> [Int]
    forall a. [a] -> [a]
    reverse [Int
    1 .. Int
    m])
      | Bool
    otherwise = ([a] -> [a] -> [a])
    -> ParsecT s u m [a] -> ParsecT s u m [a] -> ParsecT s u m [a]
    forall (m :: * -> *) a1 a2 r.
    Monad m =>
    (a1 -> a2 -> r) -> m a1 -> m a2 -> m r
    liftM2 [a] -> [a] -> [a]
    forall a. [a] -> [a] -> [a]
    (++) (Int -> ParsecT s u m a -> ParsecT s u m [a]
    forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
    replicateM Int
    n ParsecT s u m a
    p) (Int -> Int -> ParsecT s u m a -> ParsecT s u m [a]
    forall s u (m :: * -> *) a.
    Int -> Int -> ParsecT s u m a -> ParsecT s u m [a]
    manyNtoM Int
    0 (Int
    m Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    n) ParsecT s u m a
    p)

    ----------------------------------------------------------------------
    -- * Primitive Parsers
    ----------------------------------------------------------------------

    -- | Match any character of the alphabet.

    alpha :: Stream s m Char => ParsecT s u m Char
    alpha :: forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
    alpha = (Char -> Bool) -> ParsecT s u m Char
    forall s (m :: * -> *) u.
    Stream s m Char =>
    (Char -> Bool) -> ParsecT s u m Char
    satisfy (\Char
    c -> Char
    c Char -> String -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` ([Char
    'A' .. Char
    'Z'] String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ [Char
    'a' .. Char
    'z'])) ParsecT s u m Char -> String -> ParsecT s u m Char
    forall s u (m :: * -> *) a.
    ParsecT s u m a -> String -> ParsecT s u m a
    <?> String
    "alphabetic character"

    -- | Match either \"1\" or \"0\".

    bit :: Stream s m Char => ParsecT s u m Char
    bit :: forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
    bit = String -> ParsecT s u m Char
    forall s (m :: * -> *) u.
    Stream s m Char =>
    String -> ParsecT s u m Char
    oneOf String
    "01" ParsecT s u m Char -> String -> ParsecT s u m Char
    forall s u (m :: * -> *) a.
    ParsecT s u m a -> String -> ParsecT s u m a
    <?> String
    "bit ('0' or '1')"

    -- | Match any 7-bit US-ASCII character except for NUL (ASCII value 0, that
    -- is).

    character :: Stream s m Char => ParsecT s u m Char
    character :: forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
    character = (Char -> Bool) -> ParsecT s u m Char
    forall s (m :: * -> *) u.
    Stream s m Char =>
    (Char -> Bool) -> ParsecT s u m Char
    satisfy (\Char
    c -> (Char
    c Char -> Char -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Int -> Char
    chr Int
    1) Bool -> Bool -> Bool
    && (Char
    c Char -> Char -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int -> Char
    chr Int
    127)) ParsecT s u m Char -> String -> ParsecT s u m Char
    forall s u (m :: * -> *) a.
    ParsecT s u m a -> String -> ParsecT s u m a
    <?> String
    "7-bit character excluding NUL"

    -- | Match the carriage return character @\\r@.

    cr :: Stream s m Char => ParsecT s u m Char
    cr :: forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
    cr = Char -> ParsecT s u m Char
    forall s (m :: * -> *) u.
    Stream s m Char =>
    Char -> ParsecT s u m Char
    char Char
    '\r' ParsecT s u m Char -> String -> ParsecT s u m Char
    forall s u (m :: * -> *) a.
    ParsecT s u m a -> String -> ParsecT s u m a
    <?> String
    "carriage return"

    -- | Match returns the linefeed character @\\n@.

    lf :: Stream s m Char => ParsecT s u m Char
    lf :: forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
    lf = Char -> ParsecT s u m Char
    forall s (m :: * -> *) u.
    Stream s m Char =>
    Char -> ParsecT s u m Char
    char Char
    '\n' ParsecT s u m Char -> String -> ParsecT s u m Char
    forall s u (m :: * -> *) a.
    ParsecT s u m a -> String -> ParsecT s u m a
    <?> String
    "linefeed"

    -- | Match the Internet newline @\\r\\n@.

    crlf :: Stream s m Char => ParsecT s u m String
    crlf :: forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m String
    crlf = do Char
    c <- ParsecT s u m Char
    forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
    cr
              Char
    l <- ParsecT s u m Char
    forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
    lf
              String -> ParsecT s u m String
    forall a. a -> ParsecT s u m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return [Char
    c, Char
    l]
           ParsecT s u m String -> String -> ParsecT s u m String
    forall s u (m :: * -> *) a.
    ParsecT s u m a -> String -> ParsecT s u m a
    <?> String
    "carriage return followed by linefeed"

    -- | Match any US-ASCII control character. That is any character with a decimal
    -- value in the range of [0..31,127].

    ctl :: Stream s m Char => ParsecT s u m Char
    ctl :: forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
    ctl = (Char -> Bool) -> ParsecT s u m Char
    forall s (m :: * -> *) u.
    Stream s m Char =>
    (Char -> Bool) -> ParsecT s u m Char
    satisfy (\Char
    c -> Char -> Int
    ord Char
    c Int -> [Int] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` ([Int
    0 .. Int
    31] [Int] -> [Int] -> [Int]
    forall a. [a] -> [a] -> [a]
    ++ [Int
    127])) ParsecT s u m Char -> String -> ParsecT s u m Char
    forall s u (m :: * -> *) a.
    ParsecT s u m a -> String -> ParsecT s u m a
    <?> String
    "control character"

    -- | Match the double quote character \"@\"@\".

    dquote :: Stream s m Char => ParsecT s u m Char
    dquote :: forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
    dquote = Char -> ParsecT s u m Char
    forall s (m :: * -> *) u.
    Stream s m Char =>
    Char -> ParsecT s u m Char
    char (Int -> Char
    chr Int
    34) ParsecT s u m Char -> String -> ParsecT s u m Char
    forall s u (m :: * -> *) a.
    ParsecT s u m a -> String -> ParsecT s u m a
    <?> String
    "double quote"

    -- | Match any character that is valid in a hexadecimal number; [\'0\'..\'9\']
    -- and [\'A\'..\'F\',\'a\'..\'f\'] that is.

    hexdig :: Stream s m Char => ParsecT s u m Char
    hexdig :: forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
    hexdig = ParsecT s u m Char
    forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
    hexDigit ParsecT s u m Char -> String -> ParsecT s u m Char
    forall s u (m :: * -> *) a.
    ParsecT s u m a -> String -> ParsecT s u m a
    <?> String
    "hexadecimal digit"

    -- | Match the tab (\"@\\t@\") character.

    htab :: Stream s m Char => ParsecT s u m Char
    htab :: forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
    htab = Char -> ParsecT s u m Char
    forall s (m :: * -> *) u.
    Stream s m Char =>
    Char -> ParsecT s u m Char
    char Char
    '\t' ParsecT s u m Char -> String -> ParsecT s u m Char
    forall s u (m :: * -> *) a.
    ParsecT s u m a -> String -> ParsecT s u m a
    <?> String
    "horizontal tab"

    -- | Match \"linear white-space\". That is any number of consecutive 'wsp',
    -- optionally followed by a 'crlf' and (at least) one more 'wsp'.

    lwsp :: Stream s m Char => ParsecT s u m String
    lwsp :: forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m String
    lwsp = do String
    r  <- [ParsecT s u m String] -> ParsecT s u m String
    forall s (m :: * -> *) t u a.
    Stream s m t =>
    [ParsecT s u m a] -> ParsecT s u m a
    choice [ParsecT s u m Char -> ParsecT s u m String
    forall s (m :: * -> *) t u a.
    Stream s m t =>
    ParsecT s u m a -> ParsecT s u m [a]
    many1 ParsecT s u m Char
    forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
    wsp, ParsecT s u m String -> ParsecT s u m String
    forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
    try ((String -> String -> String)
    -> ParsecT s u m String
    -> ParsecT s u m String
    -> ParsecT s u m String
    forall (m :: * -> *) a1 a2 r.
    Monad m =>
    (a1 -> a2 -> r) -> m a1 -> m a2 -> m r
    liftM2 String -> String -> String
    forall a. [a] -> [a] -> [a]
    (++) ParsecT s u m String
    forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m String
    crlf (ParsecT s u m Char -> ParsecT s u m String
    forall s (m :: * -> *) t u a.
    Stream s m t =>
    ParsecT s u m a -> ParsecT s u m [a]
    many1 ParsecT s u m Char
    forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
    wsp))]
              String
    rs <- String -> ParsecT s u m String -> ParsecT s u m String
    forall s (m :: * -> *) t a u.
    Stream s m t =>
    a -> ParsecT s u m a -> ParsecT s u m a
    option [] ParsecT s u m String
    forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m String
    lwsp
              String -> ParsecT s u m String
    forall a. a -> ParsecT s u m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (String
    r String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    rs)
           ParsecT s u m String -> String -> ParsecT s u m String
    forall s u (m :: * -> *) a.
    ParsecT s u m a -> String -> ParsecT s u m a
    <?> String
    "linear white-space"

    -- | Match /any/ character.
    octet :: Stream s m Char => ParsecT s u m Char
    octet :: forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
    octet = ParsecT s u m Char
    forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
    anyChar ParsecT s u m Char -> String -> ParsecT s u m Char
    forall s u (m :: * -> *) a.
    ParsecT s u m a -> String -> ParsecT s u m a
    <?> String
    "any 8-bit character"

    -- | Match the space.

    sp :: Stream s m Char => ParsecT s u m Char
    sp :: forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
    sp = Char -> ParsecT s u m Char
    forall s (m :: * -> *) u.
    Stream s m Char =>
    Char -> ParsecT s u m Char
    char Char
    ' ' ParsecT s u m Char -> String -> ParsecT s u m Char
    forall s u (m :: * -> *) a.
    ParsecT s u m a -> String -> ParsecT s u m a
    <?> String
    "space"

    -- | Match any printable ASCII character. (The \"v\" stands for \"visible\".)
    -- That is any character in the decimal range of [33..126].

    vchar :: Stream s m Char => ParsecT s u m Char
    vchar :: forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
    vchar = (Char -> Bool) -> ParsecT s u m Char
    forall s (m :: * -> *) u.
    Stream s m Char =>
    (Char -> Bool) -> ParsecT s u m Char
    satisfy (\Char
    c -> (Char
    c Char -> Char -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Int -> Char
    chr Int
    33) Bool -> Bool -> Bool
    && (Char
    c Char -> Char -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int -> Char
    chr Int
    126)) ParsecT s u m Char -> String -> ParsecT s u m Char
    forall s u (m :: * -> *) a.
    ParsecT s u m a -> String -> ParsecT s u m a
    <?> String
    "printable character"

    -- | Match either 'sp' or 'htab'.

    wsp :: Stream s m Char => ParsecT s u m Char
    wsp :: forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
    wsp = ParsecT s u m Char
    forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
    sp ParsecT s u m Char -> ParsecT s u m Char -> ParsecT s u m Char
    forall s u (m :: * -> *) a.
    ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
    <|> ParsecT s u m Char
    forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
    htab ParsecT s u m Char -> String -> ParsecT s u m Char
    forall s u (m :: * -> *) a.
    ParsecT s u m a -> String -> ParsecT s u m a
    <?> String
    "white-space"

    -- ** Useful additions

    -- | Match a \"quoted pair\". Any characters (excluding CR and LF) may be
    -- quoted.

    quoted_pair :: Stream s m Char => ParsecT s u m String
    quoted_pair :: forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m String
    quoted_pair = do Char
    _ <- Char -> ParsecT s u m Char
    forall s (m :: * -> *) u.
    Stream s m Char =>
    Char -> ParsecT s u m Char
    char Char
    '\\'
                     Char
    r <- String -> ParsecT s u m Char
    forall s (m :: * -> *) u.
    Stream s m Char =>
    String -> ParsecT s u m Char
    noneOf String
    "\r\n"
                     String -> ParsecT s u m String
    forall a. a -> ParsecT s u m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return [Char
    '\\', Char
    r]
                  ParsecT s u m String -> String -> ParsecT s u m String
    forall s u (m :: * -> *) a.
    ParsecT s u m a -> String -> ParsecT s u m a
    <?> String
    "quoted pair"

    -- | Match a quoted string. The specials \"@\\@\" and \"@\"@\" must be escaped
    -- inside a quoted string; CR and LF are not allowed at all.

    quoted_string :: Stream s m Char => ParsecT s u m String
    quoted_string :: forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m String
    quoted_string = do Char
    _ <- ParsecT s u m Char
    forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
    dquote
                       [String]
    r <- ParsecT s u m String -> ParsecT s u m [String]
    forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
    many ParsecT s u m String
    forall {u}. ParsecT s u m String
    qcont
                       Char
    _ <- ParsecT s u m Char
    forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
    dquote
                       String -> ParsecT s u m String
    forall a. a -> ParsecT s u m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (String
    "\"" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ [String] -> String
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat [String]
    r String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "\"")
                    ParsecT s u m String -> String -> ParsecT s u m String
    forall s u (m :: * -> *) a.
    ParsecT s u m a -> String -> ParsecT s u m a
    <?> String
    "quoted string"
     where
      qtext :: ParsecT s u m Char
    qtext = String -> ParsecT s u m Char
    forall s (m :: * -> *) u.
    Stream s m Char =>
    String -> ParsecT s u m Char
    noneOf String
    "\\\"\r\n"
      qcont :: ParsecT s u m String
    qcont = ParsecT s u m Char -> ParsecT s u m String
    forall s (m :: * -> *) t u a.
    Stream s m t =>
    ParsecT s u m a -> ParsecT s u m [a]
    many1 ParsecT s u m Char
    forall {u}. ParsecT s u m Char
    qtext ParsecT s u m String
    -> ParsecT s u m String -> ParsecT s u m String
    forall s u (m :: * -> *) a.
    ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
    <|> ParsecT s u m String
    forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m String
    quoted_pair