{-# LANGUAGE BangPatterns        #-}
{-# LANGUAGE CPP                 #-}
{-# LANGUAGE FlexibleContexts    #-}
{-# LANGUAGE GADTs               #-}
{-# LANGUAGE RankNTypes          #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Distribution.Parsec (
    Parsec(..),
    ParsecParser (..),
    runParsecParser,
    runParsecParser',
    simpleParsec,
    simpleParsecBS,
    simpleParsec',
    simpleParsecW',
    lexemeParsec,
    eitherParsec,
    explicitEitherParsec,
    explicitEitherParsec',
    -- * CabalParsing and diagnostics
    CabalParsing (..),
    -- ** Warnings
    PWarnType (..),
    PWarning (..),
    showPWarning,
    -- ** Errors
    PError (..),
    showPError,
    -- * Position
    Position (..),
    incPos,
    retPos,
    showPos,
    zeroPos,
    -- * Utilities
    parsecToken,
    parsecToken',
    parsecFilePath,
    parsecQuoted,
    parsecMaybeQuoted,
    parsecCommaList,
    parsecCommaNonEmpty,
    parsecLeadingCommaList,
    parsecLeadingCommaNonEmpty,
    parsecOptCommaList,
    parsecLeadingOptCommaList,
    parsecStandard,
    parsecUnqualComponentName,
    ) where

import Data.ByteString                     (ByteString)
import Data.Char                           (digitToInt, intToDigit)
import Data.List                           (transpose)
import Distribution.CabalSpecVersion
import Distribution.Compat.Prelude
import Distribution.Parsec.Error           (PError (..), showPError)
import Distribution.Parsec.FieldLineStream (FieldLineStream, fieldLineStreamFromBS, fieldLineStreamFromString)
import Distribution.Parsec.Position        (Position (..), incPos, retPos, showPos, zeroPos)
import Distribution.Parsec.Warning         (PWarnType (..), PWarning (..), showPWarning)
import Numeric                             (showIntAtBase)
import Prelude ()

import qualified Distribution.Compat.CharParsing as P
import qualified Distribution.Compat.DList       as DList
import qualified Distribution.Compat.MonadFail   as Fail
import qualified Text.Parsec                     as Parsec

-------------------------------------------------------------------------------
-- Class
-------------------------------------------------------------------------------

-- | Class for parsing with @parsec@. Mainly used for @.cabal@ file fields.
--
-- For parsing @.cabal@ like file structure, see "Distribution.Fields".
--
class Parsec a where
    parsec :: CabalParsing m => m a

-- | Parsing class which
--
-- * can report Cabal parser warnings.
--
-- * knows @cabal-version@ we work with
--
class (P.CharParsing m, MonadPlus m, Fail.MonadFail m) => CabalParsing m where
    parsecWarning :: PWarnType -> String -> m ()

    parsecHaskellString :: m String
    parsecHaskellString = forall (m :: * -> *). CharParsing m => m String
stringLiteral

    askCabalSpecVersion :: m CabalSpecVersion

-- | 'parsec' /could/ consume trailing spaces, this function /will/ consume.
lexemeParsec :: (CabalParsing m, Parsec a) => m a
lexemeParsec :: forall (m :: * -> *) a. (CabalParsing m, Parsec a) => m a
lexemeParsec = forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
parsec forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall (m :: * -> *). CharParsing m => m ()
P.spaces

newtype ParsecParser a = PP { forall a.
ParsecParser a
-> CabalSpecVersion -> Parsec FieldLineStream [PWarning] a
unPP
    :: CabalSpecVersion -> Parsec.Parsec FieldLineStream [PWarning] a
    }

liftParsec :: Parsec.Parsec FieldLineStream [PWarning] a -> ParsecParser a
liftParsec :: forall a. Parsec FieldLineStream [PWarning] a -> ParsecParser a
liftParsec Parsec FieldLineStream [PWarning] a
p = forall a.
(CabalSpecVersion -> Parsec FieldLineStream [PWarning] a)
-> ParsecParser a
PP forall a b. (a -> b) -> a -> b
$ \CabalSpecVersion
_ -> Parsec FieldLineStream [PWarning] a
p

instance Functor ParsecParser where
    fmap :: forall a b. (a -> b) -> ParsecParser a -> ParsecParser b
fmap a -> b
f ParsecParser a
p = forall a.
(CabalSpecVersion -> Parsec FieldLineStream [PWarning] a)
-> ParsecParser a
PP forall a b. (a -> b) -> a -> b
$ \CabalSpecVersion
v -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f (forall a.
ParsecParser a
-> CabalSpecVersion -> Parsec FieldLineStream [PWarning] a
unPP ParsecParser a
p CabalSpecVersion
v)
    {-# INLINE fmap #-}

    a
x <$ :: forall a b. a -> ParsecParser b -> ParsecParser a
<$ ParsecParser b
p = forall a.
(CabalSpecVersion -> Parsec FieldLineStream [PWarning] a)
-> ParsecParser a
PP forall a b. (a -> b) -> a -> b
$ \CabalSpecVersion
v -> a
x forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall a.
ParsecParser a
-> CabalSpecVersion -> Parsec FieldLineStream [PWarning] a
unPP ParsecParser b
p CabalSpecVersion
v
    {-# INLINE (<$) #-}

instance Applicative ParsecParser where
    pure :: forall a. a -> ParsecParser a
pure = forall a. Parsec FieldLineStream [PWarning] a -> ParsecParser a
liftParsec forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Applicative f => a -> f a
pure
    {-# INLINE pure #-}

    ParsecParser (a -> b)
f <*> :: forall a b.
ParsecParser (a -> b) -> ParsecParser a -> ParsecParser b
<*> ParsecParser a
x = forall a.
(CabalSpecVersion -> Parsec FieldLineStream [PWarning] a)
-> ParsecParser a
PP forall a b. (a -> b) -> a -> b
$ \CabalSpecVersion
v -> forall a.
ParsecParser a
-> CabalSpecVersion -> Parsec FieldLineStream [PWarning] a
unPP ParsecParser (a -> b)
f CabalSpecVersion
v forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a.
ParsecParser a
-> CabalSpecVersion -> Parsec FieldLineStream [PWarning] a
unPP ParsecParser a
x CabalSpecVersion
v
    {-# INLINE (<*>) #-}
    ParsecParser a
f  *> :: forall a b. ParsecParser a -> ParsecParser b -> ParsecParser b
*> ParsecParser b
x = forall a.
(CabalSpecVersion -> Parsec FieldLineStream [PWarning] a)
-> ParsecParser a
PP forall a b. (a -> b) -> a -> b
$ \CabalSpecVersion
v -> forall a.
ParsecParser a
-> CabalSpecVersion -> Parsec FieldLineStream [PWarning] a
unPP ParsecParser a
f CabalSpecVersion
v  forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall a.
ParsecParser a
-> CabalSpecVersion -> Parsec FieldLineStream [PWarning] a
unPP ParsecParser b
x CabalSpecVersion
v
    {-# INLINE (*>) #-}
    ParsecParser a
f <* :: forall a b. ParsecParser a -> ParsecParser b -> ParsecParser a
<*  ParsecParser b
x = forall a.
(CabalSpecVersion -> Parsec FieldLineStream [PWarning] a)
-> ParsecParser a
PP forall a b. (a -> b) -> a -> b
$ \CabalSpecVersion
v -> forall a.
ParsecParser a
-> CabalSpecVersion -> Parsec FieldLineStream [PWarning] a
unPP ParsecParser a
f CabalSpecVersion
v forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<*  forall a.
ParsecParser a
-> CabalSpecVersion -> Parsec FieldLineStream [PWarning] a
unPP ParsecParser b
x CabalSpecVersion
v
    {-# INLINE (<*) #-}

instance Alternative ParsecParser where
    empty :: forall a. ParsecParser a
empty = forall a. Parsec FieldLineStream [PWarning] a -> ParsecParser a
liftParsec forall (f :: * -> *) a. Alternative f => f a
empty

    ParsecParser a
a <|> :: forall a. ParsecParser a -> ParsecParser a -> ParsecParser a
<|> ParsecParser a
b = forall a.
(CabalSpecVersion -> Parsec FieldLineStream [PWarning] a)
-> ParsecParser a
PP forall a b. (a -> b) -> a -> b
$ \CabalSpecVersion
v -> forall a.
ParsecParser a
-> CabalSpecVersion -> Parsec FieldLineStream [PWarning] a
unPP ParsecParser a
a CabalSpecVersion
v forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a.
ParsecParser a
-> CabalSpecVersion -> Parsec FieldLineStream [PWarning] a
unPP ParsecParser a
b CabalSpecVersion
v
    {-# INLINE (<|>) #-}

    many :: forall a. ParsecParser a -> ParsecParser [a]
many ParsecParser a
p = forall a.
(CabalSpecVersion -> Parsec FieldLineStream [PWarning] a)
-> ParsecParser a
PP forall a b. (a -> b) -> a -> b
$ \CabalSpecVersion
v -> forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (forall a.
ParsecParser a
-> CabalSpecVersion -> Parsec FieldLineStream [PWarning] a
unPP ParsecParser a
p CabalSpecVersion
v)
    {-# INLINE many #-}

    some :: forall a. ParsecParser a -> ParsecParser [a]
some ParsecParser a
p = forall a.
(CabalSpecVersion -> Parsec FieldLineStream [PWarning] a)
-> ParsecParser a
PP forall a b. (a -> b) -> a -> b
$ \CabalSpecVersion
v -> forall (f :: * -> *) a. Alternative f => f a -> f [a]
some (forall a.
ParsecParser a
-> CabalSpecVersion -> Parsec FieldLineStream [PWarning] a
unPP ParsecParser a
p CabalSpecVersion
v)
    {-# INLINE some #-}

instance Monad ParsecParser where
    return :: forall a. a -> ParsecParser a
return = forall (f :: * -> *) a. Applicative f => a -> f a
pure

    ParsecParser a
m >>= :: forall a b.
ParsecParser a -> (a -> ParsecParser b) -> ParsecParser b
>>= a -> ParsecParser b
k = forall a.
(CabalSpecVersion -> Parsec FieldLineStream [PWarning] a)
-> ParsecParser a
PP forall a b. (a -> b) -> a -> b
$ \CabalSpecVersion
v -> forall a.
ParsecParser a
-> CabalSpecVersion -> Parsec FieldLineStream [PWarning] a
unPP ParsecParser a
m CabalSpecVersion
v forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a
x -> forall a.
ParsecParser a
-> CabalSpecVersion -> Parsec FieldLineStream [PWarning] a
unPP (a -> ParsecParser b
k a
x) CabalSpecVersion
v
    {-# INLINE (>>=) #-}
    >> :: forall a b. ParsecParser a -> ParsecParser b -> ParsecParser b
(>>) = forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
(*>)
    {-# INLINE (>>) #-}

#if !(MIN_VERSION_base(4,13,0))
    fail = Fail.fail
#endif

instance MonadPlus ParsecParser where
    mzero :: forall a. ParsecParser a
mzero = forall (f :: * -> *) a. Alternative f => f a
empty
    mplus :: forall a. ParsecParser a -> ParsecParser a -> ParsecParser a
mplus = forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>)

instance Fail.MonadFail ParsecParser where
    fail :: forall a. String -> ParsecParser a
fail = forall (m :: * -> *) a. Parsing m => String -> m a
P.unexpected

instance P.Parsing ParsecParser where
    try :: forall a. ParsecParser a -> ParsecParser a
try ParsecParser a
p           = forall a.
(CabalSpecVersion -> Parsec FieldLineStream [PWarning] a)
-> ParsecParser a
PP forall a b. (a -> b) -> a -> b
$ \CabalSpecVersion
v -> forall (m :: * -> *) a. Parsing m => m a -> m a
P.try (forall a.
ParsecParser a
-> CabalSpecVersion -> Parsec FieldLineStream [PWarning] a
unPP ParsecParser a
p CabalSpecVersion
v)
    ParsecParser a
p <?> :: forall a. ParsecParser a -> String -> ParsecParser a
<?> String
d         = forall a.
(CabalSpecVersion -> Parsec FieldLineStream [PWarning] a)
-> ParsecParser a
PP forall a b. (a -> b) -> a -> b
$ \CabalSpecVersion
v -> forall a.
ParsecParser a
-> CabalSpecVersion -> Parsec FieldLineStream [PWarning] a
unPP ParsecParser a
p CabalSpecVersion
v forall (m :: * -> *) a. Parsing m => m a -> String -> m a
P.<?> String
d
    skipMany :: forall a. ParsecParser a -> ParsecParser ()
skipMany ParsecParser a
p      = forall a.
(CabalSpecVersion -> Parsec FieldLineStream [PWarning] a)
-> ParsecParser a
PP forall a b. (a -> b) -> a -> b
$ \CabalSpecVersion
v -> forall (m :: * -> *) a. Parsing m => m a -> m ()
P.skipMany (forall a.
ParsecParser a
-> CabalSpecVersion -> Parsec FieldLineStream [PWarning] a
unPP ParsecParser a
p CabalSpecVersion
v)
    skipSome :: forall a. ParsecParser a -> ParsecParser ()
skipSome ParsecParser a
p      = forall a.
(CabalSpecVersion -> Parsec FieldLineStream [PWarning] a)
-> ParsecParser a
PP forall a b. (a -> b) -> a -> b
$ \CabalSpecVersion
v -> forall (m :: * -> *) a. Parsing m => m a -> m ()
P.skipSome (forall a.
ParsecParser a
-> CabalSpecVersion -> Parsec FieldLineStream [PWarning] a
unPP ParsecParser a
p CabalSpecVersion
v)
    unexpected :: forall a. String -> ParsecParser a
unexpected      = forall a. Parsec FieldLineStream [PWarning] a -> ParsecParser a
liftParsec forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. Parsing m => String -> m a
P.unexpected
    eof :: ParsecParser ()
eof             = forall a. Parsec FieldLineStream [PWarning] a -> ParsecParser a
liftParsec forall (m :: * -> *). Parsing m => m ()
P.eof
    notFollowedBy :: forall a. Show a => ParsecParser a -> ParsecParser ()
notFollowedBy ParsecParser a
p = forall a.
(CabalSpecVersion -> Parsec FieldLineStream [PWarning] a)
-> ParsecParser a
PP forall a b. (a -> b) -> a -> b
$ \CabalSpecVersion
v -> forall (m :: * -> *) a. (Parsing m, Show a) => m a -> m ()
P.notFollowedBy (forall a.
ParsecParser a
-> CabalSpecVersion -> Parsec FieldLineStream [PWarning] a
unPP ParsecParser a
p CabalSpecVersion
v)

instance P.CharParsing ParsecParser where
    satisfy :: (Char -> Bool) -> ParsecParser Char
satisfy   = forall a. Parsec FieldLineStream [PWarning] a -> ParsecParser a
liftParsec forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). CharParsing m => (Char -> Bool) -> m Char
P.satisfy
    char :: Char -> ParsecParser Char
char      = forall a. Parsec FieldLineStream [PWarning] a -> ParsecParser a
liftParsec forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). CharParsing m => Char -> m Char
P.char
    notChar :: Char -> ParsecParser Char
notChar   = forall a. Parsec FieldLineStream [PWarning] a -> ParsecParser a
liftParsec forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). CharParsing m => Char -> m Char
P.notChar
    anyChar :: ParsecParser Char
anyChar   = forall a. Parsec FieldLineStream [PWarning] a -> ParsecParser a
liftParsec forall (m :: * -> *). CharParsing m => m Char
P.anyChar
    string :: String -> ParsecParser String
string    = forall a. Parsec FieldLineStream [PWarning] a -> ParsecParser a
liftParsec forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). CharParsing m => String -> m String
P.string

instance CabalParsing ParsecParser where
    parsecWarning :: PWarnType -> String -> ParsecParser ()
parsecWarning PWarnType
t String
w = forall a. Parsec FieldLineStream [PWarning] a -> ParsecParser a
liftParsec forall a b. (a -> b) -> a -> b
$ do
        SourcePos
spos <- forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
Parsec.getPosition
        forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
Parsec.modifyState
            (PWarnType -> Position -> String -> PWarning
PWarning PWarnType
t (Int -> Int -> Position
Position (SourcePos -> Int
Parsec.sourceLine SourcePos
spos) (SourcePos -> Int
Parsec.sourceColumn SourcePos
spos)) String
w forall a. a -> [a] -> [a]
:)
    askCabalSpecVersion :: ParsecParser CabalSpecVersion
askCabalSpecVersion = forall a.
(CabalSpecVersion -> Parsec FieldLineStream [PWarning] a)
-> ParsecParser a
PP forall (f :: * -> *) a. Applicative f => a -> f a
pure

-- | Parse a 'String' with 'lexemeParsec'.
simpleParsec :: Parsec a => String -> Maybe a
simpleParsec :: forall a. Parsec a => String -> Maybe a
simpleParsec
    = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> b -> a
const forall a. Maybe a
Nothing) forall a. a -> Maybe a
Just
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a.
ParsecParser a -> String -> FieldLineStream -> Either ParseError a
runParsecParser forall (m :: * -> *) a. (CabalParsing m, Parsec a) => m a
lexemeParsec String
"<simpleParsec>"
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> FieldLineStream
fieldLineStreamFromString

-- | Like 'simpleParsec' but for 'ByteString'
simpleParsecBS :: Parsec a => ByteString -> Maybe a
simpleParsecBS :: forall a. Parsec a => ByteString -> Maybe a
simpleParsecBS
    = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> b -> a
const forall a. Maybe a
Nothing) forall a. a -> Maybe a
Just
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a.
ParsecParser a -> String -> FieldLineStream -> Either ParseError a
runParsecParser forall (m :: * -> *) a. (CabalParsing m, Parsec a) => m a
lexemeParsec String
"<simpleParsec>"
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> FieldLineStream
fieldLineStreamFromBS

-- | Parse a 'String' with 'lexemeParsec' using specific 'CabalSpecVersion'.
--
-- @since 3.4.0.0
simpleParsec' :: Parsec a => CabalSpecVersion -> String -> Maybe a
simpleParsec' :: forall a. Parsec a => CabalSpecVersion -> String -> Maybe a
simpleParsec' CabalSpecVersion
spec
    = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> b -> a
const forall a. Maybe a
Nothing) forall a. a -> Maybe a
Just
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a.
CabalSpecVersion
-> ParsecParser a
-> String
-> FieldLineStream
-> Either ParseError a
runParsecParser' CabalSpecVersion
spec forall (m :: * -> *) a. (CabalParsing m, Parsec a) => m a
lexemeParsec String
"<simpleParsec>"
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> FieldLineStream
fieldLineStreamFromString

-- | Parse a 'String' with 'lexemeParsec' using specific 'CabalSpecVersion'.
-- Fail if there are any warnings.
--
-- @since 3.4.0.0
simpleParsecW' :: Parsec a => CabalSpecVersion -> String -> Maybe a
simpleParsecW' :: forall a. Parsec a => CabalSpecVersion -> String -> Maybe a
simpleParsecW' CabalSpecVersion
spec
    = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> b -> a
const forall a. Maybe a
Nothing) (\(a
x, [PWarning]
ws) -> if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [PWarning]
ws then forall a. a -> Maybe a
Just a
x else forall a. Maybe a
Nothing)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a.
CabalSpecVersion
-> ParsecParser a
-> String
-> FieldLineStream
-> Either ParseError a
runParsecParser' CabalSpecVersion
spec ((,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. (CabalParsing m, Parsec a) => m a
lexemeParsec forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Parsec FieldLineStream [PWarning] a -> ParsecParser a
liftParsec forall (m :: * -> *) s u. Monad m => ParsecT s u m u
Parsec.getState) String
"<simpleParsec>"
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> FieldLineStream
fieldLineStreamFromString

-- | Parse a 'String' with 'lexemeParsec'.
eitherParsec :: Parsec a => String -> Either String a
eitherParsec :: forall a. Parsec a => String -> Either String a
eitherParsec = forall a. ParsecParser a -> String -> Either String a
explicitEitherParsec forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
parsec

-- | Parse a 'String' with given 'ParsecParser'. Trailing whitespace is accepted.
explicitEitherParsec :: ParsecParser a -> String -> Either String a
explicitEitherParsec :: forall a. ParsecParser a -> String -> Either String a
explicitEitherParsec ParsecParser a
parser
    = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show) forall a b. b -> Either a b
Right
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a.
ParsecParser a -> String -> FieldLineStream -> Either ParseError a
runParsecParser (ParsecParser a
parser forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall (m :: * -> *). CharParsing m => m ()
P.spaces) String
"<eitherParsec>"
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> FieldLineStream
fieldLineStreamFromString

-- | Parse a 'String' with given 'ParsecParser' and 'CabalSpecVersion'. Trailing whitespace is accepted.
-- See 'explicitEitherParsec'.
--
-- @since 3.4.0.0
--
explicitEitherParsec' :: CabalSpecVersion -> ParsecParser a -> String -> Either String a
explicitEitherParsec' :: forall a.
CabalSpecVersion -> ParsecParser a -> String -> Either String a
explicitEitherParsec' CabalSpecVersion
spec ParsecParser a
parser
    = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show) forall a b. b -> Either a b
Right
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a.
CabalSpecVersion
-> ParsecParser a
-> String
-> FieldLineStream
-> Either ParseError a
runParsecParser' CabalSpecVersion
spec (ParsecParser a
parser forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall (m :: * -> *). CharParsing m => m ()
P.spaces) String
"<eitherParsec>"
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> FieldLineStream
fieldLineStreamFromString

-- | Run 'ParsecParser' with 'cabalSpecLatest'.
runParsecParser :: ParsecParser a -> FilePath -> FieldLineStream -> Either Parsec.ParseError a
runParsecParser :: forall a.
ParsecParser a -> String -> FieldLineStream -> Either ParseError a
runParsecParser = forall a.
CabalSpecVersion
-> ParsecParser a
-> String
-> FieldLineStream
-> Either ParseError a
runParsecParser' CabalSpecVersion
cabalSpecLatest

-- | Like 'runParsecParser' but lets specify 'CabalSpecVersion' used.
--
-- @since 3.0.0.0
--
runParsecParser' :: CabalSpecVersion -> ParsecParser a -> FilePath -> FieldLineStream -> Either Parsec.ParseError a
runParsecParser' :: forall a.
CabalSpecVersion
-> ParsecParser a
-> String
-> FieldLineStream
-> Either ParseError a
runParsecParser' CabalSpecVersion
v ParsecParser a
p String
n = forall s t u a.
Stream s Identity t =>
Parsec s u a -> u -> String -> s -> Either ParseError a
Parsec.runParser (forall a.
ParsecParser a
-> CabalSpecVersion -> Parsec FieldLineStream [PWarning] a
unPP ParsecParser a
p CabalSpecVersion
v forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall (m :: * -> *). Parsing m => m ()
P.eof) [] String
n

instance Parsec a => Parsec (Identity a) where
    parsec :: forall (m :: * -> *). CabalParsing m => m (Identity a)
parsec = forall a. a -> Identity a
Identity forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
parsec

instance Parsec Bool where
    parsec :: forall (m :: * -> *). CabalParsing m => m Bool
parsec = forall (m :: * -> *). CharParsing m => (Char -> Bool) -> m String
P.munch1 Char -> Bool
isAlpha forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall {f :: * -> *}. CabalParsing f => String -> f Bool
postprocess
      where
        postprocess :: String -> f Bool
postprocess String
str
            |  String
str forall a. Eq a => a -> a -> Bool
== String
"True"  = forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
            |  String
str forall a. Eq a => a -> a -> Bool
== String
"False" = forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
            | String
lstr forall a. Eq a => a -> a -> Bool
== String
"true"  = forall (m :: * -> *). CabalParsing m => PWarnType -> String -> m ()
parsecWarning PWarnType
PWTBoolCase String
caseWarning forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
            | String
lstr forall a. Eq a => a -> a -> Bool
== String
"false" = forall (m :: * -> *). CabalParsing m => PWarnType -> String -> m ()
parsecWarning PWarnType
PWTBoolCase String
caseWarning forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
            | Bool
otherwise       = forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Not a boolean: " forall a. [a] -> [a] -> [a]
++ String
str
          where
            lstr :: String
lstr = forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower String
str
            caseWarning :: String
caseWarning =
                String
"Boolean values are case sensitive, use 'True' or 'False'."

-- | @[^ ,]@
parsecToken :: CabalParsing m => m String
parsecToken :: forall (m :: * -> *). CabalParsing m => m String
parsecToken = forall (m :: * -> *). CabalParsing m => m String
parsecHaskellString forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ((forall (m :: * -> *). CharParsing m => (Char -> Bool) -> m String
P.munch1 (\Char
x -> Bool -> Bool
not (Char -> Bool
isSpace Char
x) Bool -> Bool -> Bool
&& Char
x forall a. Eq a => a -> a -> Bool
/= Char
',')  forall (m :: * -> *) a. Parsing m => m a -> String -> m a
P.<?> String
"identifier" ) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *). CabalParsing m => String -> m String
checkNotDoubleDash)

-- | @[^ ]@
parsecToken' :: CabalParsing m => m String
parsecToken' :: forall (m :: * -> *). CabalParsing m => m String
parsecToken' = forall (m :: * -> *). CabalParsing m => m String
parsecHaskellString forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ((forall (m :: * -> *). CharParsing m => (Char -> Bool) -> m String
P.munch1 (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isSpace) forall (m :: * -> *) a. Parsing m => m a -> String -> m a
P.<?> String
"token") forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *). CabalParsing m => String -> m String
checkNotDoubleDash)

checkNotDoubleDash ::  CabalParsing m => String -> m String
checkNotDoubleDash :: forall (m :: * -> *). CabalParsing m => String -> m String
checkNotDoubleDash String
s = do
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (String
s forall a. Eq a => a -> a -> Bool
== String
"--") forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). CabalParsing m => PWarnType -> String -> m ()
parsecWarning PWarnType
PWTDoubleDash forall a b. (a -> b) -> a -> b
$ [String] -> String
unwords
        [ String
"Double-dash token found."
        , String
"Note: there are no end-of-line comments in .cabal files, only whole line comments."
        , String
"Use \"--\" (quoted double dash) to silence this warning, if you actually want -- token"
        ]

    forall (m :: * -> *) a. Monad m => a -> m a
return String
s

parsecFilePath :: CabalParsing m => m FilePath
parsecFilePath :: forall (m :: * -> *). CabalParsing m => m String
parsecFilePath = forall (m :: * -> *). CabalParsing m => m String
parsecToken

-- | Parse a benchmark/test-suite types.
parsecStandard :: (CabalParsing m, Parsec ver) => (ver -> String -> a) -> m a
parsecStandard :: forall (m :: * -> *) ver a.
(CabalParsing m, Parsec ver) =>
(ver -> String -> a) -> m a
parsecStandard ver -> String -> a
f = do
    [String]
cs   <- forall (f :: * -> *) a. Alternative f => f a -> f [a]
some forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Parsing m => m a -> m a
P.try (m String
component forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall (m :: * -> *). CharParsing m => Char -> m Char
P.char Char
'-')
    ver
ver  <- forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
parsec
    let name :: String
name = forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower (forall a. [a] -> [[a]] -> [a]
intercalate String
"-" [String]
cs)
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! ver -> String -> a
f ver
ver String
name
  where
    component :: m String
component = do
      String
cs <- forall (m :: * -> *). CharParsing m => (Char -> Bool) -> m String
P.munch1 Char -> Bool
isAlphaNum
      if forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isDigit String
cs then forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"all digit component" else forall (m :: * -> *) a. Monad m => a -> m a
return String
cs
      -- each component must contain an alphabetic character, to avoid
      -- ambiguity in identifiers like foo-1 (the 1 is the version number).

parsecCommaList :: CabalParsing m => m a -> m [a]
parsecCommaList :: forall (m :: * -> *) a. CabalParsing m => m a -> m [a]
parsecCommaList m a
p = forall (m :: * -> *) a sep. Alternative m => m a -> m sep -> m [a]
P.sepBy (m a
p forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall (m :: * -> *). CharParsing m => m ()
P.spaces) (forall (m :: * -> *). CharParsing m => Char -> m Char
P.char Char
',' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (m :: * -> *). CharParsing m => m ()
P.spaces forall (m :: * -> *) a. Parsing m => m a -> String -> m a
P.<?> String
"comma")

parsecCommaNonEmpty :: CabalParsing m => m a -> m (NonEmpty a)
parsecCommaNonEmpty :: forall (m :: * -> *) a. CabalParsing m => m a -> m (NonEmpty a)
parsecCommaNonEmpty m a
p = forall (m :: * -> *) a sep.
Alternative m =>
m a -> m sep -> m (NonEmpty a)
P.sepByNonEmpty (m a
p forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall (m :: * -> *). CharParsing m => m ()
P.spaces) (forall (m :: * -> *). CharParsing m => Char -> m Char
P.char Char
',' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (m :: * -> *). CharParsing m => m ()
P.spaces forall (m :: * -> *) a. Parsing m => m a -> String -> m a
P.<?> String
"comma")

-- | Like 'parsecCommaList' but accept leading or trailing comma.
--
-- @
-- p (comma p)*  -- p `sepBy` comma
-- (comma p)*    -- leading comma
-- (p comma)*    -- trailing comma
-- @
parsecLeadingCommaList :: CabalParsing m => m a -> m [a]
parsecLeadingCommaList :: forall (m :: * -> *) a. CabalParsing m => m a -> m [a]
parsecLeadingCommaList m a
p = do
    Maybe ()
c <- forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional m ()
comma
    case Maybe ()
c of
        Maybe ()
Nothing -> forall (t :: * -> *) a. Foldable t => t a -> [a]
toList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a sep.
Alternative m =>
m a -> m sep -> m (NonEmpty a)
P.sepEndByNonEmpty m a
lp m ()
comma forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a. Applicative f => a -> f a
pure []
        Just ()
_  -> forall (t :: * -> *) a. Foldable t => t a -> [a]
toList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a sep.
Alternative m =>
m a -> m sep -> m (NonEmpty a)
P.sepByNonEmpty m a
lp m ()
comma
  where
    lp :: m a
lp = m a
p forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall (m :: * -> *). CharParsing m => m ()
P.spaces
    comma :: m ()
comma = forall (m :: * -> *). CharParsing m => Char -> m Char
P.char Char
',' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (m :: * -> *). CharParsing m => m ()
P.spaces forall (m :: * -> *) a. Parsing m => m a -> String -> m a
P.<?> String
"comma"

-- |
--
-- @since 3.4.0.0
parsecLeadingCommaNonEmpty :: CabalParsing m => m a -> m (NonEmpty a)
parsecLeadingCommaNonEmpty :: forall (m :: * -> *) a. CabalParsing m => m a -> m (NonEmpty a)
parsecLeadingCommaNonEmpty m a
p = do
    Maybe ()
c <- forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional m ()
comma
    case Maybe ()
c of
        Maybe ()
Nothing -> forall (m :: * -> *) a sep.
Alternative m =>
m a -> m sep -> m (NonEmpty a)
P.sepEndByNonEmpty m a
lp m ()
comma
        Just ()
_  -> forall (m :: * -> *) a sep.
Alternative m =>
m a -> m sep -> m (NonEmpty a)
P.sepByNonEmpty m a
lp m ()
comma
  where
    lp :: m a
lp = m a
p forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall (m :: * -> *). CharParsing m => m ()
P.spaces
    comma :: m ()
comma = forall (m :: * -> *). CharParsing m => Char -> m Char
P.char Char
',' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (m :: * -> *). CharParsing m => m ()
P.spaces forall (m :: * -> *) a. Parsing m => m a -> String -> m a
P.<?> String
"comma"

parsecOptCommaList :: CabalParsing m => m a -> m [a]
parsecOptCommaList :: forall (m :: * -> *) a. CabalParsing m => m a -> m [a]
parsecOptCommaList m a
p = forall (m :: * -> *) a sep. Alternative m => m a -> m sep -> m [a]
P.sepBy (m a
p forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall (m :: * -> *). CharParsing m => m ()
P.spaces) (forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional m ()
comma)
  where
    comma :: m ()
comma = forall (m :: * -> *). CharParsing m => Char -> m Char
P.char Char
',' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (m :: * -> *). CharParsing m => m ()
P.spaces

-- | Like 'parsecOptCommaList' but
--
-- * require all or none commas
-- * accept leading or trailing comma.
--
-- @
-- p (comma p)*  -- p `sepBy` comma
-- (comma p)*    -- leading comma
-- (p comma)*    -- trailing comma
-- p*            -- no commas: many p
-- @
--
-- @since 3.0.0.0
--
parsecLeadingOptCommaList :: CabalParsing m => m a -> m [a]
parsecLeadingOptCommaList :: forall (m :: * -> *) a. CabalParsing m => m a -> m [a]
parsecLeadingOptCommaList m a
p = do
    Maybe ()
c <- forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional m ()
comma
    case Maybe ()
c of
        Maybe ()
Nothing -> m [a]
sepEndBy1Start forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a. Applicative f => a -> f a
pure []
        Just ()
_  -> forall (t :: * -> *) a. Foldable t => t a -> [a]
toList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a sep.
Alternative m =>
m a -> m sep -> m (NonEmpty a)
P.sepByNonEmpty m a
lp m ()
comma
  where
    lp :: m a
lp = m a
p forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall (m :: * -> *). CharParsing m => m ()
P.spaces
    comma :: m ()
comma = forall (m :: * -> *). CharParsing m => Char -> m Char
P.char Char
',' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (m :: * -> *). CharParsing m => m ()
P.spaces forall (m :: * -> *) a. Parsing m => m a -> String -> m a
P.<?> String
"comma"

    sepEndBy1Start :: m [a]
sepEndBy1Start = do
        a
x <- m a
lp
        Maybe ()
c <- forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional m ()
comma
        case Maybe ()
c of
            Maybe ()
Nothing -> (a
x forall a. a -> [a] -> [a]
:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a. Alternative f => f a -> f [a]
many m a
lp
            Just ()
_  -> (a
x forall a. a -> [a] -> [a]
:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a sep. Alternative m => m a -> m sep -> m [a]
P.sepEndBy m a
lp m ()
comma

-- | Content isn't unquoted
parsecQuoted :: CabalParsing m => m a -> m a
parsecQuoted :: forall (m :: * -> *) a. CabalParsing m => m a -> m a
parsecQuoted = forall (m :: * -> *) bra ket a.
Applicative m =>
m bra -> m ket -> m a -> m a
P.between (forall (m :: * -> *). CharParsing m => Char -> m Char
P.char Char
'"') (forall (m :: * -> *). CharParsing m => Char -> m Char
P.char Char
'"')

-- | @parsecMaybeQuoted p = 'parsecQuoted' p <|> p@.
parsecMaybeQuoted :: CabalParsing m => m a -> m a
parsecMaybeQuoted :: forall (m :: * -> *) a. CabalParsing m => m a -> m a
parsecMaybeQuoted m a
p = forall (m :: * -> *) a. CabalParsing m => m a -> m a
parsecQuoted m a
p forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m a
p

parsecUnqualComponentName :: forall m. CabalParsing m => m String
parsecUnqualComponentName :: forall (m :: * -> *). CabalParsing m => m String
parsecUnqualComponentName = DList Char -> m String
state0 forall a. DList a
DList.empty where
    --
    -- using @kleene@ package we can easily see that
    -- we need only two states to recognize
    -- unqual-component-name
    --
    -- Compare with declarative
    -- 'Distribution.FieldGrammar.Described.reUnqualComponent'.
    --
    -- @
    -- import Kleene
    -- import Kleene.Internal.Pretty
    -- import Algebra.Lattice
    -- import Data.Char
    --
    -- import qualified Data.RangeSet.Map as RSet
    --
    -- main = do
    --     -- this is an approximation, to get an idea.
    --     let component :: RE Char
    --         component = star alphaNum <> alpha <> star alphaNum
    --
    --         alphaNum = alpha \/ num
    --         alpha    = unions $ map char ['a'..'z']
    --         num      = unions $ map char ['0'..'9']
    --
    --         re :: RE Char
    --         re = component <> star (char '-' <> component)
    --
    --     putPretty re
    --     putPretty $ fromTM re
    -- @

    state0 :: DList.DList Char -> m String
    state0 :: DList Char -> m String
state0 DList Char
acc = do
        Char
c <- m Char
ch -- <|> fail ("Invalid component, after " ++ DList.toList acc)
        case () of
            ()
_ | Char -> Bool
isDigit Char
c    -> DList Char -> m String
state0 (forall a. DList a -> a -> DList a
DList.snoc DList Char
acc Char
c)
              | Char -> Bool
isAlphaNum Char
c -> DList Char -> m String
state1 (forall a. DList a -> a -> DList a
DList.snoc DList Char
acc Char
c)
              | Char
c forall a. Eq a => a -> a -> Bool
== Char
'-'     -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"Empty component, after " forall a. [a] -> [a] -> [a]
++ forall a. DList a -> [a]
DList.toList DList Char
acc)
              | Bool
otherwise    -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"Internal error, after " forall a. [a] -> [a] -> [a]
++ forall a. DList a -> [a]
DList.toList DList Char
acc)

    state1 :: DList.DList Char -> m String
    state1 :: DList Char -> m String
state1 DList Char
acc = DList Char -> m String
state1' DList Char
acc m String -> m String -> m String
`alt` forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. DList a -> [a]
DList.toList DList Char
acc)

    state1' :: DList.DList Char -> m String
    state1' :: DList Char -> m String
state1' DList Char
acc = do
        Char
c <- m Char
ch
        case () of
            ()
_ | Char -> Bool
isAlphaNum Char
c -> DList Char -> m String
state1 (forall a. DList a -> a -> DList a
DList.snoc DList Char
acc Char
c)
              | Char
c forall a. Eq a => a -> a -> Bool
== Char
'-'     -> DList Char -> m String
state0 (forall a. DList a -> a -> DList a
DList.snoc DList Char
acc Char
c)
              | Bool
otherwise    -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"Internal error, after " forall a. [a] -> [a] -> [a]
++ forall a. DList a -> [a]
DList.toList DList Char
acc)

    ch :: m Char
    !ch :: m Char
ch = forall (m :: * -> *). CharParsing m => (Char -> Bool) -> m Char
P.satisfy (\Char
c -> Char -> Bool
isAlphaNum Char
c Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'-')

    alt :: m String -> m String -> m String
    !alt :: m String -> m String -> m String
alt = forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>)

stringLiteral :: forall m. P.CharParsing m => m String
stringLiteral :: forall (m :: * -> *). CharParsing m => m String
stringLiteral = m String
lit where
    lit :: m String
    lit :: m String
lit = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. a -> a
id (:)) String
""
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) bra ket a.
Applicative m =>
m bra -> m ket -> m a -> m a
P.between (forall (m :: * -> *). CharParsing m => Char -> m Char
P.char Char
'"') (forall (m :: * -> *). CharParsing m => Char -> m Char
P.char Char
'"' forall (m :: * -> *) a. Parsing m => m a -> String -> m a
P.<?> String
"end of string") (forall (f :: * -> *) a. Alternative f => f a -> f [a]
many m (Maybe Char)
stringChar)
        forall (m :: * -> *) a. Parsing m => m a -> String -> m a
P.<?> String
"string"

    stringChar :: m (Maybe Char)
    stringChar :: m (Maybe Char)
stringChar = forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Char
stringLetter
         forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m (Maybe Char)
stringEscape
         forall (m :: * -> *) a. Parsing m => m a -> String -> m a
P.<?> String
"string character"

    stringLetter :: m Char
    stringLetter :: m Char
stringLetter = forall (m :: * -> *). CharParsing m => (Char -> Bool) -> m Char
P.satisfy (\Char
c -> (Char
c forall a. Eq a => a -> a -> Bool
/= Char
'"') Bool -> Bool -> Bool
&& (Char
c forall a. Eq a => a -> a -> Bool
/= Char
'\\') Bool -> Bool -> Bool
&& (Char
c forall a. Ord a => a -> a -> Bool
> Char
'\026'))

    stringEscape :: m (Maybe Char)
    stringEscape :: m (Maybe Char)
stringEscape = forall (m :: * -> *). CharParsing m => Char -> m Char
P.char Char
'\\' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> m (Maybe Char)
esc where
        esc :: m (Maybe Char)
        esc :: m (Maybe Char)
esc = forall a. Maybe a
Nothing forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ m Char
escapeGap
            forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a. Maybe a
Nothing forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ m Char
escapeEmpty
            forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). CharParsing m => m Char
escapeCode

    escapeEmpty, escapeGap :: m Char
    escapeEmpty :: m Char
escapeEmpty = forall (m :: * -> *). CharParsing m => Char -> m Char
P.char Char
'&'
    escapeGap :: m Char
escapeGap = forall (m :: * -> *). CharParsing m => m ()
P.skipSpaces1 forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (forall (m :: * -> *). CharParsing m => Char -> m Char
P.char Char
'\\' forall (m :: * -> *) a. Parsing m => m a -> String -> m a
P.<?> String
"end of string gap")

escapeCode :: forall m. P.CharParsing m => m Char
escapeCode :: forall (m :: * -> *). CharParsing m => m Char
escapeCode = (m Char
charEsc forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m Char
charNum forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m Char
charAscii forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m Char
charControl) forall (m :: * -> *) a. Parsing m => m a -> String -> m a
P.<?> String
"escape code"
  where
  charControl, charNum :: m Char
  charControl :: m Char
charControl = (\Char
c -> forall a. Enum a => Int -> a
toEnum (forall a. Enum a => a -> Int
fromEnum Char
c forall a. Num a => a -> a -> a
- forall a. Enum a => a -> Int
fromEnum Char
'@')) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (m :: * -> *). CharParsing m => Char -> m Char
P.char Char
'^' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (forall (m :: * -> *). CharParsing m => m Char
P.upper forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (m :: * -> *). CharParsing m => Char -> m Char
P.char Char
'@'))
  charNum :: m Char
charNum = forall a. Enum a => Int -> a
toEnum forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Int
num
    where
      num :: m Int
      num :: m Int
num = Int -> Int -> m Int
bounded Int
10 Int
maxchar
        forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (forall (m :: * -> *). CharParsing m => Char -> m Char
P.char Char
'o' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Int -> Int -> m Int
bounded Int
8 Int
maxchar)
        forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (forall (m :: * -> *). CharParsing m => Char -> m Char
P.char Char
'x' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Int -> Int -> m Int
bounded Int
16 Int
maxchar)
      maxchar :: Int
maxchar = forall a. Enum a => a -> Int
fromEnum (forall a. Bounded a => a
maxBound :: Char)

  bounded :: Int -> Int -> m Int
  bounded :: Int -> Int -> m Int
bounded Int
base Int
bnd = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\Int
x Char
d -> Int
base forall a. Num a => a -> a -> a
* Int
x forall a. Num a => a -> a -> a
+ Char -> Int
digitToInt Char
d) Int
0
                 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [m Char] -> [Int] -> m String
bounded' (forall a. Int -> [a] -> [a]
take Int
base [m Char]
thedigits) (forall a b. (a -> b) -> [a] -> [b]
map Char -> Int
digitToInt forall a b. (a -> b) -> a -> b
$ forall a. (Integral a, Show a) => a -> (Int -> Char) -> a -> ShowS
showIntAtBase Int
base Int -> Char
intToDigit Int
bnd String
"")
    where
      thedigits :: [m Char]
      thedigits :: [m Char]
thedigits = forall a b. (a -> b) -> [a] -> [b]
map forall (m :: * -> *). CharParsing m => Char -> m Char
P.char [Char
'0'..Char
'9'] forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map forall (m :: * -> *). CharParsing m => String -> m Char
P.oneOf (forall a. [[a]] -> [[a]]
transpose [[Char
'A'..Char
'F'],[Char
'a'..Char
'f']])

      toomuch :: m a
      toomuch :: forall a. m a
toomuch = forall (m :: * -> *) a. Parsing m => String -> m a
P.unexpected String
"out-of-range numeric escape sequence"

      bounded', bounded'' :: [m Char] -> [Int] -> m [Char]
      bounded' :: [m Char] -> [Int] -> m String
bounded' dps :: [m Char]
dps@(m Char
zero:[m Char]
_) [Int]
bds = forall (m :: * -> *) a. Parsing m => m a -> m ()
P.skipSome m Char
zero forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ([] forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (m :: * -> *) a. (Parsing m, Show a) => m a -> m ()
P.notFollowedBy (forall (m :: * -> *) a. Alternative m => [m a] -> m a
P.choice [m Char]
dps) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [m Char] -> [Int] -> m String
bounded'' [m Char]
dps [Int]
bds)
                              forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [m Char] -> [Int] -> m String
bounded'' [m Char]
dps [Int]
bds
      bounded' []           [Int]
_   = forall a. HasCallStack => String -> a
error String
"bounded called with base 0"
      bounded'' :: [m Char] -> [Int] -> m String
bounded'' [m Char]
dps []         = [] forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (m :: * -> *) a. (Parsing m, Show a) => m a -> m ()
P.notFollowedBy (forall (m :: * -> *) a. Alternative m => [m a] -> m a
P.choice [m Char]
dps) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a. m a
toomuch
      bounded'' [m Char]
dps (Int
bd : [Int]
bds) = let anyd :: m Char
                                     anyd :: m Char
anyd = forall (m :: * -> *) a. Alternative m => [m a] -> m a
P.choice [m Char]
dps

                                     nomore :: m ()
                                     nomore :: m ()
nomore = forall (m :: * -> *) a. (Parsing m, Show a) => m a -> m ()
P.notFollowedBy m Char
anyd forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a. m a
toomuch

                                     ([m Char]
low, m Char
ex, [m Char]
high) = case forall a. Int -> [a] -> ([a], [a])
splitAt Int
bd [m Char]
dps of
                                        ([m Char]
low', m Char
ex' : [m Char]
high') -> ([m Char]
low', m Char
ex', [m Char]
high')
                                        ([m Char]
_, [m Char]
_)              -> forall a. HasCallStack => String -> a
error String
"escapeCode: Logic error"
                                  in ((:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. Alternative m => [m a] -> m a
P.choice [m Char]
low forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall {t} {f :: * -> *} {a}.
(Ord t, Num t, Alternative f) =>
t -> f a -> f [a]
atMost (forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
bds) m Char
anyd) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* m ()
nomore
                                     forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ((:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Char
ex forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ([] forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ m ()
nomore forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [m Char] -> [Int] -> m String
bounded'' [m Char]
dps [Int]
bds))
                                     forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> if Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Int]
bds)
                                            then (:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. Alternative m => [m a] -> m a
P.choice [m Char]
high forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall {t} {f :: * -> *} {a}.
(Ord t, Num t, Alternative f) =>
t -> f a -> f [a]
atMost (forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
bds forall a. Num a => a -> a -> a
- Int
1) m Char
anyd forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* m ()
nomore
                                            else forall (f :: * -> *) a. Alternative f => f a
empty
      atMost :: t -> f a -> f [a]
atMost t
n f a
p | t
n forall a. Ord a => a -> a -> Bool
<= t
0    = forall (f :: * -> *) a. Applicative f => a -> f a
pure []
                 | Bool
otherwise = ((:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f a
p forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> t -> f a -> f [a]
atMost (t
n forall a. Num a => a -> a -> a
- t
1) f a
p) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a. Applicative f => a -> f a
pure []

  charEsc :: m Char
  charEsc :: m Char
charEsc = forall (m :: * -> *) a. Alternative m => [m a] -> m a
P.choice forall a b. (a -> b) -> a -> b
$ forall {f :: * -> *} {a}. CharParsing f => (Char, a) -> f a
parseEsc forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Char, Char)]
escMap

  parseEsc :: (Char, a) -> f a
parseEsc (Char
c,a
code) = a
code forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (m :: * -> *). CharParsing m => Char -> m Char
P.char Char
c
  escMap :: [(Char, Char)]
escMap = forall a b. [a] -> [b] -> [(a, b)]
zip String
"abfnrtv\\\"\'" String
"\a\b\f\n\r\t\v\\\"\'"

  charAscii :: m Char
  charAscii :: m Char
charAscii = forall (m :: * -> *) a. Alternative m => [m a] -> m a
P.choice forall a b. (a -> b) -> a -> b
$ forall {m :: * -> *} {a}. CharParsing m => (String, a) -> m a
parseAscii forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(String, Char)]
asciiMap

  parseAscii :: (String, a) -> m a
parseAscii (String
asc,a
code) = forall (m :: * -> *) a. Parsing m => m a -> m a
P.try forall a b. (a -> b) -> a -> b
$ a
code forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (m :: * -> *). CharParsing m => String -> m String
P.string String
asc
  asciiMap :: [(String, Char)]
asciiMap = forall a b. [a] -> [b] -> [(a, b)]
zip ([String]
ascii3codes forall a. [a] -> [a] -> [a]
++ [String]
ascii2codes) (String
ascii3 forall a. [a] -> [a] -> [a]
++ String
ascii2)
  ascii2codes, ascii3codes :: [String]
  ascii2codes :: [String]
ascii2codes = [ String
"BS",String
"HT",String
"LF",String
"VT",String
"FF",String
"CR",String
"SO"
                , String
"SI",String
"EM",String
"FS",String
"GS",String
"RS",String
"US",String
"SP"]
  ascii3codes :: [String]
ascii3codes = [String
"NUL",String
"SOH",String
"STX",String
"ETX",String
"EOT",String
"ENQ",String
"ACK"
                ,String
"BEL",String
"DLE",String
"DC1",String
"DC2",String
"DC3",String
"DC4",String
"NAK"
                ,String
"SYN",String
"ETB",String
"CAN",String
"SUB",String
"ESC",String
"DEL"]
  ascii2, ascii3 :: String
  ascii2 :: String
ascii2 = String
"\BS\HT\LF\VT\FF\CR\SO\SI\EM\FS\GS\RS\US\SP"
  ascii3 :: String
ascii3 = String
"\NUL\SOH\STX\ETX\EOT\ENQ\ACK\BEL\DLE\DC1\DC2\DC3\DC4\NAK\SYN\ETB\CAN\SUB\ESC\DEL"