{-# 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 :: forall (m :: * -> *) a. (CabalParsing m, Parsec a) => m a
lexemeParsec = m a
forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
forall (m :: * -> *). CabalParsing m => m a
parsec m a -> m () -> m a
forall a b. m a -> m b -> 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
  { 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 = (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 :: forall a b. (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 a b.
(a -> b)
-> ParsecT FieldLineStream [PWarning] Identity a
-> ParsecT FieldLineStream [PWarning] Identity 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 <$ :: forall a b. 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 a b.
a
-> ParsecT FieldLineStream [PWarning] Identity b
-> ParsecT FieldLineStream [PWarning] Identity 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 :: forall a. 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 a. a -> ParsecT FieldLineStream [PWarning] Identity a
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 = (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 a b.
ParsecT FieldLineStream [PWarning] Identity (a -> b)
-> ParsecT FieldLineStream [PWarning] Identity a
-> ParsecT FieldLineStream [PWarning] Identity 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 *> :: forall a b. 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 a b.
ParsecT FieldLineStream [PWarning] Identity a
-> ParsecT FieldLineStream [PWarning] Identity b
-> ParsecT FieldLineStream [PWarning] Identity 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 <* :: forall a b. 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 a b.
ParsecT FieldLineStream [PWarning] Identity a
-> ParsecT FieldLineStream [PWarning] Identity b
-> ParsecT FieldLineStream [PWarning] Identity 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 :: forall a. ParsecParser a
empty = Parsec FieldLineStream [PWarning] a -> ParsecParser a
forall a. Parsec FieldLineStream [PWarning] a -> ParsecParser a
liftParsec Parsec FieldLineStream [PWarning] a
forall a. ParsecT FieldLineStream [PWarning] Identity a
forall (f :: * -> *) a. Alternative f => f a
empty

  ParsecParser a
a <|> :: forall 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 a.
ParsecT FieldLineStream [PWarning] Identity a
-> ParsecT FieldLineStream [PWarning] Identity a
-> ParsecT FieldLineStream [PWarning] Identity 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 :: forall a. 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 a.
ParsecT FieldLineStream [PWarning] Identity a
-> ParsecT FieldLineStream [PWarning] Identity [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 :: forall a. 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 a.
ParsecT FieldLineStream [PWarning] Identity a
-> ParsecT FieldLineStream [PWarning] Identity [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 :: forall a. a -> ParsecParser a
return = a -> ParsecParser a
forall a. a -> ParsecParser a
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 = (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 a b.
ParsecT FieldLineStream [PWarning] Identity a
-> (a -> ParsecT FieldLineStream [PWarning] Identity b)
-> ParsecT FieldLineStream [PWarning] Identity 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 (>>=) #-}
  >> :: forall a b. ParsecParser a -> ParsecParser b -> ParsecParser b
(>>) = ParsecParser a -> ParsecParser b -> ParsecParser b
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 = ParsecParser a
forall a. ParsecParser a
forall (f :: * -> *) a. Alternative f => f a
empty
  mplus :: forall a. ParsecParser a -> ParsecParser a -> ParsecParser a
mplus = ParsecParser a -> ParsecParser a -> ParsecParser a
forall a. ParsecParser a -> ParsecParser a -> ParsecParser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>)

instance Fail.MonadFail ParsecParser where
  fail :: forall a. String -> ParsecParser a
fail = String -> ParsecParser a
forall a. String -> ParsecParser a
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 = (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 a.
ParsecT FieldLineStream [PWarning] Identity a
-> ParsecT FieldLineStream [PWarning] Identity 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 <?> :: forall a. 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 a.
ParsecT FieldLineStream [PWarning] Identity a
-> String -> ParsecT FieldLineStream [PWarning] Identity a
forall (m :: * -> *) a. Parsing m => m a -> String -> m a
P.<?> String
d
  skipMany :: forall a. 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 a.
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 :: forall a. 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 a.
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 :: forall a. 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 a. String -> ParsecT FieldLineStream [PWarning] Identity 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 :: forall a. Show a => 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 a.
Show a =>
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
    spos <- ParsecT FieldLineStream [PWarning] Identity SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
Parsec.getPosition
    Parsec.modifyState
      (PWarning t (Position (Parsec.sourceLine spos) (Parsec.sourceColumn spos)) w :)
  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 a. a -> ParsecT FieldLineStream [PWarning] Identity a
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 =
  (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 :: forall a. Parsec a => 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' :: forall a. Parsec a => 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' :: forall a. Parsec a => 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 a. [a] -> 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 a b.
ParsecParser (a -> b) -> ParsecParser a -> ParsecParser b
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 :: forall a. Parsec a => 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
forall (m :: * -> *). 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 =
  (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 a b. ParsecParser a -> ParsecParser b -> 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' :: forall a.
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 a b. ParsecParser a -> ParsecParser b -> 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 :: forall a.
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' :: forall a.
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 a b.
ParsecT FieldLineStream [PWarning] Identity a
-> ParsecT FieldLineStream [PWarning] Identity b
-> ParsecT FieldLineStream [PWarning] Identity 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 :: forall (m :: * -> *). CabalParsing m => 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
forall (m :: * -> *). CabalParsing m => m a
parsec

instance Parsec Bool where
  parsec :: forall (m :: * -> *). CabalParsing m => 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 a b. m a -> (a -> m b) -> m b
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 a. a -> f a
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 a. a -> f a
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 a b. f a -> f b -> f b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Bool -> f Bool
forall a. a -> f a
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 a b. f a -> f b -> f b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Bool -> f Bool
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
        | Bool
otherwise = String -> f Bool
forall a. String -> f a
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 :: forall (m :: * -> *). CabalParsing m => m String
parsecToken = m String
forall (m :: * -> *). CabalParsing m => m String
parsecHaskellString m String -> m String -> m String
forall a. m a -> m a -> m a
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 a. m a -> String -> m a
forall (m :: * -> *) a. Parsing m => m a -> String -> m a
P.<?> String
"identifier") m String -> (String -> m String) -> m String
forall a b. m a -> (a -> m b) -> m b
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' :: forall (m :: * -> *). CabalParsing m => m String
parsecToken' = m String
forall (m :: * -> *). CabalParsing m => m String
parsecHaskellString m String -> m String -> m String
forall a. m a -> m a -> m a
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 a. m a -> String -> m a
forall (m :: * -> *) a. Parsing m => m a -> String -> m a
P.<?> String
"token") m String -> (String -> m String) -> m String
forall a b. m a -> (a -> m b) -> m b
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 :: forall (m :: * -> *). CabalParsing m => 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 a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return String
s

parsecFilePath :: CabalParsing m => m FilePath
parsecFilePath :: forall (m :: * -> *). CabalParsing m => 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 :: forall (m :: * -> *) ver a.
(CabalParsing m, Parsec ver) =>
(ver -> String -> a) -> m a
parsecStandard ver -> String -> a
f = do
  cs <- m String -> m [String]
forall a. m a -> m [a]
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 a. m a -> m a
forall (m :: * -> *) a. Parsing m => m a -> m a
P.try (m String
component m String -> m Char -> m String
forall a b. m a -> m b -> m a
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 <- parsec
  let 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)
  return $! f ver name
  where
    component :: m String
component = do
      cs <- (Char -> Bool) -> m String
forall (m :: * -> *). CharParsing m => (Char -> Bool) -> m String
P.munch1 Char -> Bool
isAlphaNum
      if all isDigit cs then fail "all digit component" else return 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 = 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 a b. m a -> m b -> 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 a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> m ()
forall (m :: * -> *). CharParsing m => m ()
P.spaces m () -> String -> m ()
forall a. m a -> String -> m a
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 = 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 a b. m a -> m b -> 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 a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> m ()
forall (m :: * -> *). CharParsing m => m ()
P.spaces m () -> String -> m ()
forall a. m a -> String -> m a
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
  c <- m () -> m (Maybe ())
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional m ()
comma
  case c of
    Maybe ()
Nothing -> NonEmpty a -> [a]
forall a. 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 a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [a] -> m [a]
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
    Just ()
_ -> NonEmpty a -> [a]
forall a. 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 a b. m a -> m b -> 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 a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> m ()
forall (m :: * -> *). CharParsing m => m ()
P.spaces m () -> String -> m ()
forall a. m a -> String -> m a
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
  c <- m () -> m (Maybe ())
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional m ()
comma
  case 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 a b. m a -> m b -> 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 a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> m ()
forall (m :: * -> *). CharParsing m => m ()
P.spaces m () -> String -> m ()
forall a. m a -> String -> m a
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 = 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 a b. m a -> m b -> 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 a b. m a -> m b -> m b
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 :: forall (m :: * -> *) a. CabalParsing m => m a -> m [a]
parsecLeadingOptCommaList m a
p = do
  c <- m () -> m (Maybe ())
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional m ()
comma
  case c of
    Maybe ()
Nothing -> m [a]
sepEndBy1Start m [a] -> m [a] -> m [a]
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [a] -> m [a]
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
    Just ()
_ -> NonEmpty a -> [a]
forall a. 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 a b. m a -> m b -> 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 a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> m ()
forall (m :: * -> *). CharParsing m => m ()
P.spaces m () -> String -> m ()
forall a. m a -> String -> m a
forall (m :: * -> *) a. Parsing m => m a -> String -> m a
P.<?> String
"comma"

    sepEndBy1Start :: m [a]
sepEndBy1Start = do
      x <- m a
lp
      c <- P.optional comma
      case 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 a. 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 :: forall (m :: * -> *) a. CabalParsing m => 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 :: forall (m :: * -> *) a. CabalParsing m => 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 a. 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 :: forall (m :: * -> *). CabalParsing m => 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
      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 a. String -> m a
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 a. String -> m a
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 a. a -> m a
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
      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 a. String -> m a
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 a. m a -> m a -> m a
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 =
      (Maybe Char -> String -> String)
-> String -> [Maybe Char] -> String
forall a b. (a -> b -> b) -> b -> [a] -> b
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 a. m a -> String -> m a
forall (m :: * -> *) a. Parsing m => m a -> String -> m a
P.<?> String
"end of string") (m (Maybe Char) -> m [Maybe Char]
forall a. m a -> m [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many m (Maybe Char)
stringChar)
        m String -> String -> m String
forall a. m a -> String -> m a
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 a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m (Maybe Char)
stringEscape
        m (Maybe Char) -> String -> m (Maybe Char)
forall a. m a -> String -> m a
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 a b. m a -> m b -> m b
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 a b. a -> m b -> m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ m Char
escapeGap
            m (Maybe Char) -> m (Maybe Char) -> m (Maybe Char)
forall a. m a -> m a -> m a
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 a b. a -> m b -> m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ m Char
escapeEmpty
            m (Maybe Char) -> m (Maybe Char) -> m (Maybe Char)
forall a. m a -> m a -> m a
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 a b. m a -> m b -> m b
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 a. m a -> String -> m a
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 m Char -> m Char -> m Char
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m Char
charNum m Char -> m Char -> m Char
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m Char
charAscii m Char -> m Char -> m Char
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m Char
charControl) m Char -> String -> m Char
forall a. m a -> String -> m a
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 a b. m a -> m b -> m b
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 a. m a -> m a -> m a
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 a. m a -> m a -> m a
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 a b. m a -> m b -> m b
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 a. m a -> m a -> m a
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 a b. m a -> m b -> m b
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 b a. (b -> a -> b) -> b -> [a] -> b
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 => 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 :: forall a. m a
toomuch = String -> m a
forall a. 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 a. m a -> m ()
forall (m :: * -> *) a. Parsing m => m a -> m ()
P.skipSome m Char
zero m () -> m String -> m String
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ([] String -> m () -> m String
forall a b. a -> m b -> m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ m Char -> m ()
forall a. Show a => m a -> 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 a. m a -> m a -> m a
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 a. m a -> m a -> m a
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 a b. a -> m b -> m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ m Char -> m ()
forall a. Show a => m a -> 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 a. m a -> m a -> m a
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 a. Show a => m a -> m ()
forall (m :: * -> *) a. (Parsing m, Show a) => m a -> m ()
P.notFollowedBy m Char
anyd m () -> m () -> m ()
forall a. m a -> m a -> m a
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 a b. m (a -> b) -> m a -> m b
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 a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
bds) m Char
anyd) m String -> m () -> m String
forall a b. m a -> m b -> m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* m ()
nomore
                m String -> m String -> m String
forall a. m a -> m a -> m a
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 a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ([] String -> m () -> m String
forall a b. a -> m b -> m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ m ()
nomore m String -> m String -> m String
forall a. m a -> m a -> m a
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 a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> if Bool -> Bool
not ([Int] -> Bool
forall a. [a] -> 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 a b. m (a -> b) -> m a -> m b
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 a. [a] -> 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 a b. m a -> m b -> m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* m ()
nomore
                  else m String
forall a. m a
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 a. 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 a b. f (a -> b) -> f a -> f b
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 a. f a -> f a -> f a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [a] -> f [a]
forall 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 a b. a -> f b -> 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 a. 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 a b. a -> m b -> 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"