{-# 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 = m String
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 :: m a
lexemeParsec = m a
forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
parsec m a -> m () -> m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* m ()
forall (m :: * -> *). CharParsing m => m ()
P.spaces

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

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

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

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

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

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

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

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

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

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

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

    ParsecParser a
m >>= :: ParsecParser a -> (a -> ParsecParser b) -> ParsecParser b
>>= a -> ParsecParser b
k = (CabalSpecVersion -> Parsec FieldLineStream [PWarning] b)
-> ParsecParser b
forall a.
(CabalSpecVersion -> Parsec FieldLineStream [PWarning] a)
-> ParsecParser a
PP ((CabalSpecVersion -> Parsec FieldLineStream [PWarning] b)
 -> ParsecParser b)
-> (CabalSpecVersion -> Parsec FieldLineStream [PWarning] b)
-> ParsecParser b
forall a b. (a -> b) -> a -> b
$ \CabalSpecVersion
v -> ParsecParser a
-> CabalSpecVersion -> Parsec FieldLineStream [PWarning] a
forall a.
ParsecParser a
-> CabalSpecVersion -> Parsec FieldLineStream [PWarning] a
unPP ParsecParser a
m CabalSpecVersion
v Parsec FieldLineStream [PWarning] a
-> (a -> Parsec FieldLineStream [PWarning] b)
-> Parsec FieldLineStream [PWarning] b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a
x -> ParsecParser b
-> CabalSpecVersion -> Parsec FieldLineStream [PWarning] b
forall a.
ParsecParser a
-> CabalSpecVersion -> Parsec FieldLineStream [PWarning] a
unPP (a -> ParsecParser b
k a
x) CabalSpecVersion
v
    {-# INLINE (>>=) #-}
    >> :: ParsecParser a -> ParsecParser b -> ParsecParser 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 :: ParsecParser a
mzero = ParsecParser a
forall (f :: * -> *) a. Alternative f => f a
empty
    mplus :: ParsecParser a -> ParsecParser a -> ParsecParser a
mplus = ParsecParser a -> ParsecParser a -> ParsecParser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>)

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

instance P.Parsing ParsecParser where
    try :: ParsecParser a -> ParsecParser a
try ParsecParser a
p           = (CabalSpecVersion -> Parsec FieldLineStream [PWarning] a)
-> ParsecParser a
forall a.
(CabalSpecVersion -> Parsec FieldLineStream [PWarning] a)
-> ParsecParser a
PP ((CabalSpecVersion -> Parsec FieldLineStream [PWarning] a)
 -> ParsecParser a)
-> (CabalSpecVersion -> Parsec FieldLineStream [PWarning] a)
-> ParsecParser a
forall a b. (a -> b) -> a -> b
$ \CabalSpecVersion
v -> Parsec FieldLineStream [PWarning] a
-> Parsec FieldLineStream [PWarning] a
forall (m :: * -> *) a. Parsing m => m a -> m a
P.try (ParsecParser a
-> CabalSpecVersion -> Parsec FieldLineStream [PWarning] a
forall a.
ParsecParser a
-> CabalSpecVersion -> Parsec FieldLineStream [PWarning] a
unPP ParsecParser a
p CabalSpecVersion
v)
    ParsecParser a
p <?> :: ParsecParser a -> String -> ParsecParser a
<?> String
d         = (CabalSpecVersion -> Parsec FieldLineStream [PWarning] a)
-> ParsecParser a
forall a.
(CabalSpecVersion -> Parsec FieldLineStream [PWarning] a)
-> ParsecParser a
PP ((CabalSpecVersion -> Parsec FieldLineStream [PWarning] a)
 -> ParsecParser a)
-> (CabalSpecVersion -> Parsec FieldLineStream [PWarning] a)
-> ParsecParser a
forall a b. (a -> b) -> a -> b
$ \CabalSpecVersion
v -> ParsecParser a
-> CabalSpecVersion -> Parsec FieldLineStream [PWarning] a
forall a.
ParsecParser a
-> CabalSpecVersion -> Parsec FieldLineStream [PWarning] a
unPP ParsecParser a
p CabalSpecVersion
v Parsec FieldLineStream [PWarning] a
-> String -> Parsec FieldLineStream [PWarning] a
forall (m :: * -> *) a. Parsing m => m a -> String -> m a
P.<?> String
d
    skipMany :: ParsecParser a -> ParsecParser ()
skipMany ParsecParser a
p      = (CabalSpecVersion -> Parsec FieldLineStream [PWarning] ())
-> ParsecParser ()
forall a.
(CabalSpecVersion -> Parsec FieldLineStream [PWarning] a)
-> ParsecParser a
PP ((CabalSpecVersion -> Parsec FieldLineStream [PWarning] ())
 -> ParsecParser ())
-> (CabalSpecVersion -> Parsec FieldLineStream [PWarning] ())
-> ParsecParser ()
forall a b. (a -> b) -> a -> b
$ \CabalSpecVersion
v -> ParsecT FieldLineStream [PWarning] Identity a
-> Parsec FieldLineStream [PWarning] ()
forall (m :: * -> *) a. Parsing m => m a -> m ()
P.skipMany (ParsecParser a
-> CabalSpecVersion
-> ParsecT FieldLineStream [PWarning] Identity a
forall a.
ParsecParser a
-> CabalSpecVersion -> Parsec FieldLineStream [PWarning] a
unPP ParsecParser a
p CabalSpecVersion
v)
    skipSome :: ParsecParser a -> ParsecParser ()
skipSome ParsecParser a
p      = (CabalSpecVersion -> Parsec FieldLineStream [PWarning] ())
-> ParsecParser ()
forall a.
(CabalSpecVersion -> Parsec FieldLineStream [PWarning] a)
-> ParsecParser a
PP ((CabalSpecVersion -> Parsec FieldLineStream [PWarning] ())
 -> ParsecParser ())
-> (CabalSpecVersion -> Parsec FieldLineStream [PWarning] ())
-> ParsecParser ()
forall a b. (a -> b) -> a -> b
$ \CabalSpecVersion
v -> ParsecT FieldLineStream [PWarning] Identity a
-> Parsec FieldLineStream [PWarning] ()
forall (m :: * -> *) a. Parsing m => m a -> m ()
P.skipSome (ParsecParser a
-> CabalSpecVersion
-> ParsecT FieldLineStream [PWarning] Identity a
forall a.
ParsecParser a
-> CabalSpecVersion -> Parsec FieldLineStream [PWarning] a
unPP ParsecParser a
p CabalSpecVersion
v)
    unexpected :: String -> ParsecParser a
unexpected      = Parsec FieldLineStream [PWarning] a -> ParsecParser a
forall a. Parsec FieldLineStream [PWarning] a -> ParsecParser a
liftParsec (Parsec FieldLineStream [PWarning] a -> ParsecParser a)
-> (String -> Parsec FieldLineStream [PWarning] a)
-> String
-> ParsecParser a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Parsec FieldLineStream [PWarning] a
forall (m :: * -> *) a. Parsing m => String -> m a
P.unexpected
    eof :: ParsecParser ()
eof             = Parsec FieldLineStream [PWarning] () -> ParsecParser ()
forall a. Parsec FieldLineStream [PWarning] a -> ParsecParser a
liftParsec Parsec FieldLineStream [PWarning] ()
forall (m :: * -> *). Parsing m => m ()
P.eof
    notFollowedBy :: ParsecParser a -> ParsecParser ()
notFollowedBy ParsecParser a
p = (CabalSpecVersion -> Parsec FieldLineStream [PWarning] ())
-> ParsecParser ()
forall a.
(CabalSpecVersion -> Parsec FieldLineStream [PWarning] a)
-> ParsecParser a
PP ((CabalSpecVersion -> Parsec FieldLineStream [PWarning] ())
 -> ParsecParser ())
-> (CabalSpecVersion -> Parsec FieldLineStream [PWarning] ())
-> ParsecParser ()
forall a b. (a -> b) -> a -> b
$ \CabalSpecVersion
v -> ParsecT FieldLineStream [PWarning] Identity a
-> Parsec FieldLineStream [PWarning] ()
forall (m :: * -> *) a. (Parsing m, Show a) => m a -> m ()
P.notFollowedBy (ParsecParser a
-> CabalSpecVersion
-> ParsecT FieldLineStream [PWarning] Identity a
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   = Parsec FieldLineStream [PWarning] Char -> ParsecParser Char
forall a. Parsec FieldLineStream [PWarning] a -> ParsecParser a
liftParsec (Parsec FieldLineStream [PWarning] Char -> ParsecParser Char)
-> ((Char -> Bool) -> Parsec FieldLineStream [PWarning] Char)
-> (Char -> Bool)
-> ParsecParser Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Parsec FieldLineStream [PWarning] Char
forall (m :: * -> *). CharParsing m => (Char -> Bool) -> m Char
P.satisfy
    char :: Char -> ParsecParser Char
char      = Parsec FieldLineStream [PWarning] Char -> ParsecParser Char
forall a. Parsec FieldLineStream [PWarning] a -> ParsecParser a
liftParsec (Parsec FieldLineStream [PWarning] Char -> ParsecParser Char)
-> (Char -> Parsec FieldLineStream [PWarning] Char)
-> Char
-> ParsecParser Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Parsec FieldLineStream [PWarning] Char
forall (m :: * -> *). CharParsing m => Char -> m Char
P.char
    notChar :: Char -> ParsecParser Char
notChar   = Parsec FieldLineStream [PWarning] Char -> ParsecParser Char
forall a. Parsec FieldLineStream [PWarning] a -> ParsecParser a
liftParsec (Parsec FieldLineStream [PWarning] Char -> ParsecParser Char)
-> (Char -> Parsec FieldLineStream [PWarning] Char)
-> Char
-> ParsecParser Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Parsec FieldLineStream [PWarning] Char
forall (m :: * -> *). CharParsing m => Char -> m Char
P.notChar
    anyChar :: ParsecParser Char
anyChar   = Parsec FieldLineStream [PWarning] Char -> ParsecParser Char
forall a. Parsec FieldLineStream [PWarning] a -> ParsecParser a
liftParsec Parsec FieldLineStream [PWarning] Char
forall (m :: * -> *). CharParsing m => m Char
P.anyChar
    string :: String -> ParsecParser String
string    = Parsec FieldLineStream [PWarning] String -> ParsecParser String
forall a. Parsec FieldLineStream [PWarning] a -> ParsecParser a
liftParsec (Parsec FieldLineStream [PWarning] String -> ParsecParser String)
-> (String -> Parsec FieldLineStream [PWarning] String)
-> String
-> ParsecParser String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Parsec FieldLineStream [PWarning] String
forall (m :: * -> *). CharParsing m => String -> m String
P.string

instance CabalParsing ParsecParser where
    parsecWarning :: PWarnType -> String -> ParsecParser ()
parsecWarning PWarnType
t String
w = Parsec FieldLineStream [PWarning] () -> ParsecParser ()
forall a. Parsec FieldLineStream [PWarning] a -> ParsecParser a
liftParsec (Parsec FieldLineStream [PWarning] () -> ParsecParser ())
-> Parsec FieldLineStream [PWarning] () -> ParsecParser ()
forall a b. (a -> b) -> a -> b
$ do
        SourcePos
spos <- ParsecT FieldLineStream [PWarning] Identity SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
Parsec.getPosition
        ([PWarning] -> [PWarning]) -> Parsec FieldLineStream [PWarning] ()
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 PWarning -> [PWarning] -> [PWarning]
forall a. a -> [a] -> [a]
:)
    askCabalSpecVersion :: ParsecParser CabalSpecVersion
askCabalSpecVersion = (CabalSpecVersion
 -> Parsec FieldLineStream [PWarning] CabalSpecVersion)
-> ParsecParser CabalSpecVersion
forall a.
(CabalSpecVersion -> Parsec FieldLineStream [PWarning] a)
-> ParsecParser a
PP CabalSpecVersion
-> Parsec FieldLineStream [PWarning] CabalSpecVersion
forall (f :: * -> *) a. Applicative f => a -> f a
pure

-- | Parse a 'String' with 'lexemeParsec'.
simpleParsec :: Parsec a => String -> Maybe a
simpleParsec :: String -> Maybe a
simpleParsec
    = (ParseError -> Maybe a)
-> (a -> Maybe a) -> Either ParseError a -> Maybe a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe a -> ParseError -> Maybe a
forall a b. a -> b -> a
const Maybe a
forall a. Maybe a
Nothing) a -> Maybe a
forall a. a -> Maybe a
Just
    (Either ParseError a -> Maybe a)
-> (String -> Either ParseError a) -> String -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParsecParser a -> String -> FieldLineStream -> Either ParseError a
forall a.
ParsecParser a -> String -> FieldLineStream -> Either ParseError a
runParsecParser ParsecParser a
forall (m :: * -> *) a. (CabalParsing m, Parsec a) => m a
lexemeParsec String
"<simpleParsec>"
    (FieldLineStream -> Either ParseError a)
-> (String -> FieldLineStream) -> String -> Either ParseError a
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 :: ByteString -> Maybe a
simpleParsecBS
    = (ParseError -> Maybe a)
-> (a -> Maybe a) -> Either ParseError a -> Maybe a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe a -> ParseError -> Maybe a
forall a b. a -> b -> a
const Maybe a
forall a. Maybe a
Nothing) a -> Maybe a
forall a. a -> Maybe a
Just
    (Either ParseError a -> Maybe a)
-> (ByteString -> Either ParseError a) -> ByteString -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParsecParser a -> String -> FieldLineStream -> Either ParseError a
forall a.
ParsecParser a -> String -> FieldLineStream -> Either ParseError a
runParsecParser ParsecParser a
forall (m :: * -> *) a. (CabalParsing m, Parsec a) => m a
lexemeParsec String
"<simpleParsec>"
    (FieldLineStream -> Either ParseError a)
-> (ByteString -> FieldLineStream)
-> ByteString
-> Either ParseError a
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' :: CabalSpecVersion -> String -> Maybe a
simpleParsec' CabalSpecVersion
spec
    = (ParseError -> Maybe a)
-> (a -> Maybe a) -> Either ParseError a -> Maybe a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe a -> ParseError -> Maybe a
forall a b. a -> b -> a
const Maybe a
forall a. Maybe a
Nothing) a -> Maybe a
forall a. a -> Maybe a
Just
    (Either ParseError a -> Maybe a)
-> (String -> Either ParseError a) -> String -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CabalSpecVersion
-> ParsecParser a
-> String
-> FieldLineStream
-> Either ParseError a
forall a.
CabalSpecVersion
-> ParsecParser a
-> String
-> FieldLineStream
-> Either ParseError a
runParsecParser' CabalSpecVersion
spec ParsecParser a
forall (m :: * -> *) a. (CabalParsing m, Parsec a) => m a
lexemeParsec String
"<simpleParsec>"
    (FieldLineStream -> Either ParseError a)
-> (String -> FieldLineStream) -> String -> Either ParseError a
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' :: CabalSpecVersion -> String -> Maybe a
simpleParsecW' CabalSpecVersion
spec
    = (ParseError -> Maybe a)
-> ((a, [PWarning]) -> Maybe a)
-> Either ParseError (a, [PWarning])
-> Maybe a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe a -> ParseError -> Maybe a
forall a b. a -> b -> a
const Maybe a
forall a. Maybe a
Nothing) (\(a
x, [PWarning]
ws) -> if [PWarning] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [PWarning]
ws then a -> Maybe a
forall a. a -> Maybe a
Just a
x else Maybe a
forall a. Maybe a
Nothing)
    (Either ParseError (a, [PWarning]) -> Maybe a)
-> (String -> Either ParseError (a, [PWarning]))
-> String
-> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CabalSpecVersion
-> ParsecParser (a, [PWarning])
-> String
-> FieldLineStream
-> Either ParseError (a, [PWarning])
forall a.
CabalSpecVersion
-> ParsecParser a
-> String
-> FieldLineStream
-> Either ParseError a
runParsecParser' CabalSpecVersion
spec ((,) (a -> [PWarning] -> (a, [PWarning]))
-> ParsecParser a -> ParsecParser ([PWarning] -> (a, [PWarning]))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecParser a
forall (m :: * -> *) a. (CabalParsing m, Parsec a) => m a
lexemeParsec ParsecParser ([PWarning] -> (a, [PWarning]))
-> ParsecParser [PWarning] -> ParsecParser (a, [PWarning])
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parsec FieldLineStream [PWarning] [PWarning]
-> ParsecParser [PWarning]
forall a. Parsec FieldLineStream [PWarning] a -> ParsecParser a
liftParsec Parsec FieldLineStream [PWarning] [PWarning]
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
Parsec.getState) String
"<simpleParsec>"
    (FieldLineStream -> Either ParseError (a, [PWarning]))
-> (String -> FieldLineStream)
-> String
-> Either ParseError (a, [PWarning])
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 :: String -> Either String a
eitherParsec = ParsecParser a -> String -> Either String a
forall a. ParsecParser a -> String -> Either String a
explicitEitherParsec ParsecParser a
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 :: ParsecParser a -> String -> Either String a
explicitEitherParsec ParsecParser a
parser
    = (ParseError -> Either String a)
-> (a -> Either String a) -> Either ParseError a -> Either String a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> Either String a
forall a b. a -> Either a b
Left (String -> Either String a)
-> (ParseError -> String) -> ParseError -> Either String a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseError -> String
forall a. Show a => a -> String
show) a -> Either String a
forall a b. b -> Either a b
Right
    (Either ParseError a -> Either String a)
-> (String -> Either ParseError a) -> String -> Either String a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParsecParser a -> String -> FieldLineStream -> Either ParseError a
forall a.
ParsecParser a -> String -> FieldLineStream -> Either ParseError a
runParsecParser (ParsecParser a
parser ParsecParser a -> ParsecParser () -> ParsecParser a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecParser ()
forall (m :: * -> *). CharParsing m => m ()
P.spaces) String
"<eitherParsec>"
    (FieldLineStream -> Either ParseError a)
-> (String -> FieldLineStream) -> String -> Either ParseError a
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' :: CabalSpecVersion -> ParsecParser a -> String -> Either String a
explicitEitherParsec' CabalSpecVersion
spec ParsecParser a
parser
    = (ParseError -> Either String a)
-> (a -> Either String a) -> Either ParseError a -> Either String a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> Either String a
forall a b. a -> Either a b
Left (String -> Either String a)
-> (ParseError -> String) -> ParseError -> Either String a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseError -> String
forall a. Show a => a -> String
show) a -> Either String a
forall a b. b -> Either a b
Right
    (Either ParseError a -> Either String a)
-> (String -> Either ParseError a) -> String -> Either String a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CabalSpecVersion
-> ParsecParser a
-> String
-> FieldLineStream
-> Either ParseError a
forall a.
CabalSpecVersion
-> ParsecParser a
-> String
-> FieldLineStream
-> Either ParseError a
runParsecParser' CabalSpecVersion
spec (ParsecParser a
parser ParsecParser a -> ParsecParser () -> ParsecParser a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecParser ()
forall (m :: * -> *). CharParsing m => m ()
P.spaces) String
"<eitherParsec>"
    (FieldLineStream -> Either ParseError a)
-> (String -> FieldLineStream) -> String -> Either ParseError a
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 :: ParsecParser a -> String -> FieldLineStream -> Either ParseError a
runParsecParser = CabalSpecVersion
-> ParsecParser a
-> String
-> FieldLineStream
-> Either ParseError a
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' :: CabalSpecVersion
-> ParsecParser a
-> String
-> FieldLineStream
-> Either ParseError a
runParsecParser' CabalSpecVersion
v ParsecParser a
p String
n = Parsec FieldLineStream [PWarning] a
-> [PWarning] -> String -> FieldLineStream -> Either ParseError a
forall s t u a.
Stream s Identity t =>
Parsec s u a -> u -> String -> s -> Either ParseError a
Parsec.runParser (ParsecParser a
-> CabalSpecVersion -> Parsec FieldLineStream [PWarning] a
forall a.
ParsecParser a
-> CabalSpecVersion -> Parsec FieldLineStream [PWarning] a
unPP ParsecParser a
p CabalSpecVersion
v Parsec FieldLineStream [PWarning] a
-> Parsec FieldLineStream [PWarning] ()
-> Parsec FieldLineStream [PWarning] a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parsec FieldLineStream [PWarning] ()
forall (m :: * -> *). Parsing m => m ()
P.eof) [] String
n

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

instance Parsec Bool where
    parsec :: m Bool
parsec = (Char -> Bool) -> m String
forall (m :: * -> *). CharParsing m => (Char -> Bool) -> m String
P.munch1 Char -> Bool
isAlpha m String -> (String -> m Bool) -> m Bool
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> m Bool
forall (f :: * -> *). CabalParsing f => String -> f Bool
postprocess
      where
        postprocess :: String -> f Bool
postprocess String
str
            |  String
str String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"True"  = Bool -> f Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
            |  String
str String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"False" = Bool -> f Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
            | String
lstr String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"true"  = PWarnType -> String -> f ()
forall (m :: * -> *). CabalParsing m => PWarnType -> String -> m ()
parsecWarning PWarnType
PWTBoolCase String
caseWarning f () -> f Bool -> f Bool
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Bool -> f Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
            | String
lstr String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"false" = PWarnType -> String -> f ()
forall (m :: * -> *). CabalParsing m => PWarnType -> String -> m ()
parsecWarning PWarnType
PWTBoolCase String
caseWarning f () -> f Bool -> f Bool
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Bool -> f Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
            | Bool
otherwise       = String -> f Bool
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> f Bool) -> String -> f Bool
forall a b. (a -> b) -> a -> b
$ String
"Not a boolean: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
str
          where
            lstr :: String
lstr = (Char -> Char) -> String -> String
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 :: m String
parsecToken = m String
forall (m :: * -> *). CabalParsing m => m String
parsecHaskellString m String -> m String -> m String
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (((Char -> Bool) -> m String
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 Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
',')  m String -> String -> m String
forall (m :: * -> *) a. Parsing m => m a -> String -> m a
P.<?> String
"identifier" ) m String -> (String -> m String) -> m String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> m String
forall (m :: * -> *). CabalParsing m => String -> m String
checkNotDoubleDash)

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

checkNotDoubleDash ::  CabalParsing m => String -> m String
checkNotDoubleDash :: String -> m String
checkNotDoubleDash String
s = do
    Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"--") (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ PWarnType -> String -> m ()
forall (m :: * -> *). CabalParsing m => PWarnType -> String -> m ()
parsecWarning PWarnType
PWTDoubleDash (String -> m ()) -> String -> m ()
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"
        ]

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

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

-- | Parse a benchmark/test-suite types.
parsecStandard :: (CabalParsing m, Parsec ver) => (ver -> String -> a) -> m a
parsecStandard :: (ver -> String -> a) -> m a
parsecStandard ver -> String -> a
f = do
    [String]
cs   <- m String -> m [String]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some (m String -> m [String]) -> m String -> m [String]
forall a b. (a -> b) -> a -> b
$ m String -> m String
forall (m :: * -> *) a. Parsing m => m a -> m a
P.try (m String
component m String -> m Char -> m String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> m Char
forall (m :: * -> *). CharParsing m => Char -> m Char
P.char Char
'-')
    ver
ver  <- m ver
forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
parsec
    let name :: String
name = (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower (String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"-" [String]
cs)
    a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> m a) -> a -> m a
forall a b. (a -> b) -> a -> b
$! ver -> String -> a
f ver
ver String
name
  where
    component :: m String
component = do
      String
cs <- (Char -> Bool) -> m String
forall (m :: * -> *). CharParsing m => (Char -> Bool) -> m String
P.munch1 Char -> Bool
isAlphaNum
      if (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isDigit String
cs then String -> m String
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"all digit component" else String -> m String
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 :: m a -> m [a]
parsecCommaList m a
p = m a -> m () -> m [a]
forall (m :: * -> *) a sep. Alternative m => m a -> m sep -> m [a]
P.sepBy (m a
p m a -> m () -> m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* m ()
forall (m :: * -> *). CharParsing m => m ()
P.spaces) (Char -> m Char
forall (m :: * -> *). CharParsing m => Char -> m Char
P.char Char
',' m Char -> m () -> m ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> m ()
forall (m :: * -> *). CharParsing m => m ()
P.spaces m () -> String -> m ()
forall (m :: * -> *) a. Parsing m => m a -> String -> m a
P.<?> String
"comma")

parsecCommaNonEmpty :: CabalParsing m => m a -> m (NonEmpty a)
parsecCommaNonEmpty :: m a -> m (NonEmpty a)
parsecCommaNonEmpty m a
p = m a -> m () -> m (NonEmpty a)
forall (m :: * -> *) a sep.
Alternative m =>
m a -> m sep -> m (NonEmpty a)
P.sepByNonEmpty (m a
p m a -> m () -> m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* m ()
forall (m :: * -> *). CharParsing m => m ()
P.spaces) (Char -> m Char
forall (m :: * -> *). CharParsing m => Char -> m Char
P.char Char
',' m Char -> m () -> m ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> m ()
forall (m :: * -> *). CharParsing m => m ()
P.spaces m () -> String -> m ()
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 :: m a -> m [a]
parsecLeadingCommaList m a
p = do
    Maybe ()
c <- m () -> m (Maybe ())
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional m ()
comma
    case Maybe ()
c of
        Maybe ()
Nothing -> NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (NonEmpty a -> [a]) -> m (NonEmpty a) -> m [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m a -> m () -> m (NonEmpty a)
forall (m :: * -> *) a sep.
Alternative m =>
m a -> m sep -> m (NonEmpty a)
P.sepEndByNonEmpty m a
lp m ()
comma m [a] -> m [a] -> m [a]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [a] -> m [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
        Just ()
_  -> NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (NonEmpty a -> [a]) -> m (NonEmpty a) -> m [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m a -> m () -> m (NonEmpty a)
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 m a -> m () -> m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* m ()
forall (m :: * -> *). CharParsing m => m ()
P.spaces
    comma :: m ()
comma = Char -> m Char
forall (m :: * -> *). CharParsing m => Char -> m Char
P.char Char
',' m Char -> m () -> m ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> m ()
forall (m :: * -> *). CharParsing m => m ()
P.spaces m () -> String -> m ()
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 :: m a -> m (NonEmpty a)
parsecLeadingCommaNonEmpty m a
p = do
    Maybe ()
c <- m () -> m (Maybe ())
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional m ()
comma
    case Maybe ()
c of
        Maybe ()
Nothing -> m a -> m () -> m (NonEmpty a)
forall (m :: * -> *) a sep.
Alternative m =>
m a -> m sep -> m (NonEmpty a)
P.sepEndByNonEmpty m a
lp m ()
comma
        Just ()
_  -> m a -> m () -> m (NonEmpty a)
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 m a -> m () -> m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* m ()
forall (m :: * -> *). CharParsing m => m ()
P.spaces
    comma :: m ()
comma = Char -> m Char
forall (m :: * -> *). CharParsing m => Char -> m Char
P.char Char
',' m Char -> m () -> m ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> m ()
forall (m :: * -> *). CharParsing m => m ()
P.spaces m () -> String -> m ()
forall (m :: * -> *) a. Parsing m => m a -> String -> m a
P.<?> String
"comma"

parsecOptCommaList :: CabalParsing m => m a -> m [a]
parsecOptCommaList :: m a -> m [a]
parsecOptCommaList m a
p = m a -> m (Maybe ()) -> m [a]
forall (m :: * -> *) a sep. Alternative m => m a -> m sep -> m [a]
P.sepBy (m a
p m a -> m () -> m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* m ()
forall (m :: * -> *). CharParsing m => m ()
P.spaces) (m () -> m (Maybe ())
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional m ()
comma)
  where
    comma :: m ()
comma = Char -> m Char
forall (m :: * -> *). CharParsing m => Char -> m Char
P.char Char
',' m Char -> m () -> m ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> m ()
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 :: m a -> m [a]
parsecLeadingOptCommaList m a
p = do
    Maybe ()
c <- m () -> m (Maybe ())
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional m ()
comma
    case Maybe ()
c of
        Maybe ()
Nothing -> m [a]
sepEndBy1Start m [a] -> m [a] -> m [a]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [a] -> m [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
        Just ()
_  -> NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (NonEmpty a -> [a]) -> m (NonEmpty a) -> m [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m a -> m () -> m (NonEmpty a)
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 m a -> m () -> m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* m ()
forall (m :: * -> *). CharParsing m => m ()
P.spaces
    comma :: m ()
comma = Char -> m Char
forall (m :: * -> *). CharParsing m => Char -> m Char
P.char Char
',' m Char -> m () -> m ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> m ()
forall (m :: * -> *). CharParsing m => m ()
P.spaces m () -> String -> m ()
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 <- m () -> m (Maybe ())
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional m ()
comma
        case Maybe ()
c of
            Maybe ()
Nothing -> (a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
:) ([a] -> [a]) -> m [a] -> m [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m a -> m [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many m a
lp
            Just ()
_  -> (a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
:) ([a] -> [a]) -> m [a] -> m [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m a -> m () -> m [a]
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 :: m a -> m a
parsecQuoted = m Char -> m Char -> m a -> m a
forall (m :: * -> *) bra ket a.
Applicative m =>
m bra -> m ket -> m a -> m a
P.between (Char -> m Char
forall (m :: * -> *). CharParsing m => Char -> m Char
P.char Char
'"') (Char -> m Char
forall (m :: * -> *). CharParsing m => Char -> m Char
P.char Char
'"')

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

parsecUnqualComponentName :: forall m. CabalParsing m => m String
parsecUnqualComponentName :: m String
parsecUnqualComponentName = DList Char -> m String
state0 DList Char
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 (DList Char -> Char -> DList Char
forall a. DList a -> a -> DList a
DList.snoc DList Char
acc Char
c)
              | Char -> Bool
isAlphaNum Char
c -> DList Char -> m String
state1 (DList Char -> Char -> DList Char
forall a. DList a -> a -> DList a
DList.snoc DList Char
acc Char
c)
              | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-'     -> String -> m String
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"Empty component, after " String -> String -> String
forall a. [a] -> [a] -> [a]
++ DList Char -> String
forall a. DList a -> [a]
DList.toList DList Char
acc)
              | Bool
otherwise    -> String -> m String
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"Internal error, after " String -> String -> String
forall a. [a] -> [a] -> [a]
++ DList Char -> String
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` String -> m String
forall (m :: * -> *) a. Monad m => a -> m a
return (DList Char -> String
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 (DList Char -> Char -> DList Char
forall a. DList a -> a -> DList a
DList.snoc DList Char
acc Char
c)
              | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-'     -> DList Char -> m String
state0 (DList Char -> Char -> DList Char
forall a. DList a -> a -> DList a
DList.snoc DList Char
acc Char
c)
              | Bool
otherwise    -> String -> m String
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"Internal error, after " String -> String -> String
forall a. [a] -> [a] -> [a]
++ DList Char -> String
forall a. DList a -> [a]
DList.toList DList Char
acc)

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

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

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

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

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

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

    escapeEmpty, escapeGap :: m Char
    escapeEmpty :: m Char
escapeEmpty = Char -> m Char
forall (m :: * -> *). CharParsing m => Char -> m Char
P.char Char
'&'
    escapeGap :: m Char
escapeGap = m ()
forall (m :: * -> *). CharParsing m => m ()
P.skipSpaces1 m () -> m Char -> m Char
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Char -> m Char
forall (m :: * -> *). CharParsing m => Char -> m Char
P.char Char
'\\' m Char -> String -> m 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 :: m Char
escapeCode = (m Char
charEsc m Char -> m Char -> m Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m Char
charNum m Char -> m Char -> m Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m Char
charAscii m Char -> m Char -> m Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m Char
charControl) m Char -> String -> m Char
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 -> Int -> Char
forall a. Enum a => Int -> a
toEnum (Char -> Int
forall a. Enum a => a -> Int
fromEnum Char
c Int -> Int -> Int
forall a. Num a => a -> a -> a
- Char -> Int
forall a. Enum a => a -> Int
fromEnum Char
'@')) (Char -> Char) -> m Char -> m Char
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> m Char
forall (m :: * -> *). CharParsing m => Char -> m Char
P.char Char
'^' m Char -> m Char -> m Char
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (m Char
forall (m :: * -> *). CharParsing m => m Char
P.upper m Char -> m Char -> m Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Char -> m Char
forall (m :: * -> *). CharParsing m => Char -> m Char
P.char Char
'@'))
  charNum :: m Char
charNum = Int -> Char
forall a. Enum a => Int -> a
toEnum (Int -> Char) -> m Int -> m Char
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
        m Int -> m Int -> m Int
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Char -> m Char
forall (m :: * -> *). CharParsing m => Char -> m Char
P.char Char
'o' m Char -> m Int -> m Int
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Int -> Int -> m Int
bounded Int
8 Int
maxchar)
        m Int -> m Int -> m Int
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Char -> m Char
forall (m :: * -> *). CharParsing m => Char -> m Char
P.char Char
'x' m Char -> m Int -> m Int
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Int -> Int -> m Int
bounded Int
16 Int
maxchar)
      maxchar :: Int
maxchar = Char -> Int
forall a. Enum a => a -> Int
fromEnum (Char
forall a. Bounded a => a
maxBound :: Char)

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

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

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

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

  charEsc :: m Char
  charEsc :: m Char
charEsc = [m Char] -> m Char
forall (m :: * -> *) a. Alternative m => [m a] -> m a
P.choice ([m Char] -> m Char) -> [m Char] -> m Char
forall a b. (a -> b) -> a -> b
$ (Char, Char) -> m Char
forall (f :: * -> *) a. CharParsing f => (Char, a) -> f a
parseEsc ((Char, Char) -> m Char) -> [(Char, Char)] -> [m Char]
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 a -> f Char -> f a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> f Char
forall (m :: * -> *). CharParsing m => Char -> m Char
P.char Char
c
  escMap :: [(Char, Char)]
escMap = String -> String -> [(Char, Char)]
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 = [m Char] -> m Char
forall (m :: * -> *) a. Alternative m => [m a] -> m a
P.choice ([m Char] -> m Char) -> [m Char] -> m Char
forall a b. (a -> b) -> a -> b
$ (String, Char) -> m Char
forall (m :: * -> *) a. CharParsing m => (String, a) -> m a
parseAscii ((String, Char) -> m Char) -> [(String, Char)] -> [m Char]
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) = m a -> m a
forall (m :: * -> *) a. Parsing m => m a -> m a
P.try (m a -> m a) -> m a -> m a
forall a b. (a -> b) -> a -> b
$ a
code a -> m String -> m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> m String
forall (m :: * -> *). CharParsing m => String -> m String
P.string String
asc
  asciiMap :: [(String, Char)]
asciiMap = [String] -> String -> [(String, Char)]
forall a b. [a] -> [b] -> [(a, b)]
zip ([String]
ascii3codes [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
ascii2codes) (String
ascii3 String -> String -> String
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"