diff --git a/Cabal/Cabal.cabal b/Cabal/Cabal.cabal index 906878d277b..77f4c84b774 100644 --- a/Cabal/Cabal.cabal +++ b/Cabal/Cabal.cabal @@ -38,6 +38,8 @@ extra-source-files: tests/ParserTests/errors/common2.errors tests/ParserTests/errors/common3.cabal tests/ParserTests/errors/common3.errors + tests/ParserTests/errors/leading-comma.cabal + tests/ParserTests/errors/leading-comma.errors tests/ParserTests/regressions/Octree-0.5.cabal tests/ParserTests/regressions/Octree-0.5.format tests/ParserTests/regressions/common.cabal @@ -55,10 +57,14 @@ extra-source-files: tests/ParserTests/regressions/haddock-api-2.18.1-check.cabal tests/ParserTests/regressions/issue-774.cabal tests/ParserTests/regressions/issue-774.format + tests/ParserTests/regressions/leading-comma.cabal + tests/ParserTests/regressions/leading-comma.format tests/ParserTests/regressions/nothing-unicode.cabal tests/ParserTests/regressions/nothing-unicode.format tests/ParserTests/regressions/shake.cabal tests/ParserTests/regressions/shake.format + tests/ParserTests/regressions/wl-pprint-indef.cabal + tests/ParserTests/regressions/wl-pprint-indef.format tests/ParserTests/warnings/bom.cabal tests/ParserTests/warnings/bool.cabal tests/ParserTests/warnings/deprecatedfield.cabal @@ -148,6 +154,7 @@ library Distribution.Backpack.ModSubst Distribution.Backpack.ModuleShape Distribution.Backpack.PreModuleShape + Distribution.CabalSpecVersion Distribution.Utils.IOData Distribution.Utils.LogProgress Distribution.Utils.MapAccum @@ -302,9 +309,11 @@ library build-depends: transformers, mtl >= 2.1 && <2.3, + text >= 1.2.2.2 && <1.3, parsec >= 3.1.9 && <3.2 exposed-modules: - Distribution.Compat.Parsec + Distribution.Compat.Parsing + Distribution.Compat.CharParsing Distribution.FieldGrammar Distribution.FieldGrammar.Class Distribution.FieldGrammar.Parsec diff --git a/Cabal/Distribution/CabalSpecVersion.hs b/Cabal/Distribution/CabalSpecVersion.hs new file mode 100644 index 00000000000..eb65635b7b9 --- /dev/null +++ b/Cabal/Distribution/CabalSpecVersion.hs @@ -0,0 +1,60 @@ +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveGeneric #-} +module Distribution.CabalSpecVersion where + +import Prelude () +import Distribution.Compat.Prelude +import qualified Data.Set as Set + +-- | Different Cabal-the-spec versions. +-- +-- We branch based on this at least in the parser. +-- +data CabalSpecVersion + = CabalSpecOld + | CabalSpecV20 + | CabalSpecV22 + deriving (Eq, Ord, Show, Read, Enum, Bounded, Typeable, Data, Generic) + +cabalSpecLatest :: CabalSpecVersion +cabalSpecLatest = CabalSpecV22 + +cabalSpecFeatures :: CabalSpecVersion -> Set.Set CabalFeature +cabalSpecFeatures CabalSpecOld = Set.empty +cabalSpecFeatures CabalSpecV20 = Set.empty +cabalSpecFeatures CabalSpecV22 = Set.fromList + [ Elif + , CommonStanzas + ] + +cabalSpecSupports :: CabalSpecVersion -> [Int] -> Bool +cabalSpecSupports CabalSpecOld v = v < [1,25] +cabalSpecSupports CabalSpecV20 v = v < [2,1] +cabalSpecSupports CabalSpecV22 _ = True + +specHasCommonStanzas :: CabalSpecVersion -> HasCommonStanzas +specHasCommonStanzas CabalSpecV22 = HasCommonStanzas +specHasCommonStanzas _ = NoCommonStanzas + +specHasElif :: CabalSpecVersion -> HasElif +specHasElif CabalSpecV22 = HasElif +specHasElif _ = NoElif + +------------------------------------------------------------------------------- +-- Features +------------------------------------------------------------------------------- + +data CabalFeature + = Elif + | CommonStanzas + deriving (Eq, Ord, Show, Read, Enum, Bounded, Typeable, Data, Generic) + +------------------------------------------------------------------------------- +-- Booleans +------------------------------------------------------------------------------- + +data HasElif = HasElif | NoElif + deriving (Eq, Show) + +data HasCommonStanzas = HasCommonStanzas | NoCommonStanzas + deriving (Eq, Show) diff --git a/Cabal/Distribution/Compat/CharParsing.hs b/Cabal/Distribution/Compat/CharParsing.hs new file mode 100644 index 00000000000..9a3abb61a1b --- /dev/null +++ b/Cabal/Distribution/Compat/CharParsing.hs @@ -0,0 +1,358 @@ +{-# LANGUAGE GADTs #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# OPTIONS_GHC -fspec-constr -fspec-constr-count=8 #-} +----------------------------------------------------------------------------- +-- | +-- Module : Distribution.Compat.CharParsing +-- Copyright : (c) Edward Kmett 2011 +-- License : BSD3 +-- +-- Maintainer : ekmett@gmail.com +-- Stability : experimental +-- Portability : non-portable +-- +-- Parsers for character streams +-- +-- Originally in @parsers@ package. +-- +----------------------------------------------------------------------------- +module Distribution.Compat.CharParsing + ( + -- * Combinators + oneOf -- :: CharParsing m => [Char] -> m Char + , noneOf -- :: CharParsing m => [Char] -> m Char + , spaces -- :: CharParsing m => m () + , space -- :: CharParsing m => m Char + , newline -- :: CharParsing m => m Char + , tab -- :: CharParsing m => m Char + , upper -- :: CharParsing m => m Char + , lower -- :: CharParsing m => m Char + , alphaNum -- :: CharParsing m => m Char + , letter -- :: CharParsing m => m Char + , digit -- :: CharParsing m => m Char + , hexDigit -- :: CharParsing m => m Char + , octDigit -- :: CharParsing m => m Char + , satisfyRange -- :: CharParsing m => Char -> Char -> m Char + -- * Class + , CharParsing(..) + -- * Cabal additions + , integral + , munch1 + , munch + , skipSpaces1 + , module Distribution.Compat.Parsing + ) where + +import Prelude () +import Distribution.Compat.Prelude + +import Control.Monad.Trans.Class (lift) +import Control.Monad.Trans.State.Lazy as Lazy +import Control.Monad.Trans.State.Strict as Strict +import Control.Monad.Trans.Writer.Lazy as Lazy +import Control.Monad.Trans.Writer.Strict as Strict +import Control.Monad.Trans.RWS.Lazy as Lazy +import Control.Monad.Trans.RWS.Strict as Strict +import Control.Monad.Trans.Reader (ReaderT (..)) +import Control.Monad.Trans.Identity (IdentityT (..)) +import Data.Char +import Data.Text (Text, unpack) + +import qualified Text.Parsec as Parsec +import qualified Distribution.Compat.ReadP as ReadP + +import Distribution.Compat.Parsing + +-- | @oneOf cs@ succeeds if the current character is in the supplied +-- list of characters @cs@. Returns the parsed character. See also +-- 'satisfy'. +-- +-- > vowel = oneOf "aeiou" +oneOf :: CharParsing m => [Char] -> m Char +oneOf xs = satisfy (\c -> c `elem` xs) +{-# INLINE oneOf #-} +{-# ANN oneOf "HLint: ignore Use String" #-} + +-- | As the dual of 'oneOf', @noneOf cs@ succeeds if the current +-- character is /not/ in the supplied list of characters @cs@. Returns the +-- parsed character. +-- +-- > consonant = noneOf "aeiou" +noneOf :: CharParsing m => [Char] -> m Char +noneOf xs = satisfy (\c -> c `notElem` xs) +{-# INLINE noneOf #-} +{-# ANN noneOf "HLint: ignore Use String" #-} + +-- | Skips /zero/ or more white space characters. See also 'skipMany'. +spaces :: CharParsing m => m () +spaces = skipMany space "white space" +{-# INLINE spaces #-} + +-- | Parses a white space character (any character which satisfies 'isSpace') +-- Returns the parsed character. +space :: CharParsing m => m Char +space = satisfy isSpace "space" +{-# INLINE space #-} + +-- | Parses a newline character (\'\\n\'). Returns a newline character. +newline :: CharParsing m => m Char +newline = char '\n' "new-line" +{-# INLINE newline #-} + +-- | Parses a tab character (\'\\t\'). Returns a tab character. +tab :: CharParsing m => m Char +tab = char '\t' "tab" +{-# INLINE tab #-} + +-- | Parses an upper case letter. Returns the parsed character. +upper :: CharParsing m => m Char +upper = satisfy isUpper "uppercase letter" +{-# INLINE upper #-} + +-- | Parses a lower case character. Returns the parsed character. +lower :: CharParsing m => m Char +lower = satisfy isLower "lowercase letter" +{-# INLINE lower #-} + +-- | Parses a letter or digit. Returns the parsed character. +alphaNum :: CharParsing m => m Char +alphaNum = satisfy isAlphaNum "letter or digit" +{-# INLINE alphaNum #-} + +-- | Parses a letter (an upper case or lower case character). Returns the +-- parsed character. +letter :: CharParsing m => m Char +letter = satisfy isAlpha "letter" +{-# INLINE letter #-} + +-- | Parses a digit. Returns the parsed character. +digit :: CharParsing m => m Char +digit = satisfy isDigit "digit" +{-# INLINE digit #-} + +-- | Parses a hexadecimal digit (a digit or a letter between \'a\' and +-- \'f\' or \'A\' and \'F\'). Returns the parsed character. +hexDigit :: CharParsing m => m Char +hexDigit = satisfy isHexDigit "hexadecimal digit" +{-# INLINE hexDigit #-} + +-- | Parses an octal digit (a character between \'0\' and \'7\'). Returns +-- the parsed character. +octDigit :: CharParsing m => m Char +octDigit = satisfy isOctDigit "octal digit" +{-# INLINE octDigit #-} + +satisfyRange :: CharParsing m => Char -> Char -> m Char +satisfyRange a z = satisfy (\c -> c >= a && c <= z) +{-# INLINE satisfyRange #-} + +-- | Additional functionality needed to parse character streams. +class Parsing m => CharParsing m where + -- | Parse a single character of the input, with UTF-8 decoding + satisfy :: (Char -> Bool) -> m Char + + -- | @char c@ parses a single character @c@. Returns the parsed + -- character (i.e. @c@). + -- + -- /e.g./ + -- + -- @semiColon = 'char' ';'@ + char :: Char -> m Char + char c = satisfy (c ==) show [c] + {-# INLINE char #-} + + -- | @notChar c@ parses any single character other than @c@. Returns the parsed + -- character. + notChar :: Char -> m Char + notChar c = satisfy (c /=) + {-# INLINE notChar #-} + + -- | This parser succeeds for any character. Returns the parsed character. + anyChar :: m Char + anyChar = satisfy (const True) + {-# INLINE anyChar #-} + + -- | @string s@ parses a sequence of characters given by @s@. Returns + -- the parsed string (i.e. @s@). + -- + -- > divOrMod = string "div" + -- > <|> string "mod" + string :: String -> m String + string s = s <$ try (traverse_ char s) show s + {-# INLINE string #-} + + -- | @text t@ parses a sequence of characters determined by the text @t@ Returns + -- the parsed text fragment (i.e. @t@). + -- + -- Using @OverloadedStrings@: + -- + -- > divOrMod = text "div" + -- > <|> text "mod" + text :: Text -> m Text + text t = t <$ string (unpack t) + {-# INLINE text #-} + +instance (CharParsing m, MonadPlus m) => CharParsing (Lazy.StateT s m) where + satisfy = lift . satisfy + {-# INLINE satisfy #-} + char = lift . char + {-# INLINE char #-} + notChar = lift . notChar + {-# INLINE notChar #-} + anyChar = lift anyChar + {-# INLINE anyChar #-} + string = lift . string + {-# INLINE string #-} + text = lift . text + {-# INLINE text #-} + +instance (CharParsing m, MonadPlus m) => CharParsing (Strict.StateT s m) where + satisfy = lift . satisfy + {-# INLINE satisfy #-} + char = lift . char + {-# INLINE char #-} + notChar = lift . notChar + {-# INLINE notChar #-} + anyChar = lift anyChar + {-# INLINE anyChar #-} + string = lift . string + {-# INLINE string #-} + text = lift . text + {-# INLINE text #-} + +instance (CharParsing m, MonadPlus m) => CharParsing (ReaderT e m) where + satisfy = lift . satisfy + {-# INLINE satisfy #-} + char = lift . char + {-# INLINE char #-} + notChar = lift . notChar + {-# INLINE notChar #-} + anyChar = lift anyChar + {-# INLINE anyChar #-} + string = lift . string + {-# INLINE string #-} + text = lift . text + {-# INLINE text #-} + +instance (CharParsing m, MonadPlus m, Monoid w) => CharParsing (Strict.WriterT w m) where + satisfy = lift . satisfy + {-# INLINE satisfy #-} + char = lift . char + {-# INLINE char #-} + notChar = lift . notChar + {-# INLINE notChar #-} + anyChar = lift anyChar + {-# INLINE anyChar #-} + string = lift . string + {-# INLINE string #-} + text = lift . text + {-# INLINE text #-} + +instance (CharParsing m, MonadPlus m, Monoid w) => CharParsing (Lazy.WriterT w m) where + satisfy = lift . satisfy + {-# INLINE satisfy #-} + char = lift . char + {-# INLINE char #-} + notChar = lift . notChar + {-# INLINE notChar #-} + anyChar = lift anyChar + {-# INLINE anyChar #-} + string = lift . string + {-# INLINE string #-} + text = lift . text + {-# INLINE text #-} + +instance (CharParsing m, MonadPlus m, Monoid w) => CharParsing (Lazy.RWST r w s m) where + satisfy = lift . satisfy + {-# INLINE satisfy #-} + char = lift . char + {-# INLINE char #-} + notChar = lift . notChar + {-# INLINE notChar #-} + anyChar = lift anyChar + {-# INLINE anyChar #-} + string = lift . string + {-# INLINE string #-} + text = lift . text + {-# INLINE text #-} + +instance (CharParsing m, MonadPlus m, Monoid w) => CharParsing (Strict.RWST r w s m) where + satisfy = lift . satisfy + {-# INLINE satisfy #-} + char = lift . char + {-# INLINE char #-} + notChar = lift . notChar + {-# INLINE notChar #-} + anyChar = lift anyChar + {-# INLINE anyChar #-} + string = lift . string + {-# INLINE string #-} + text = lift . text + {-# INLINE text #-} + +instance (CharParsing m, MonadPlus m) => CharParsing (IdentityT m) where + satisfy = lift . satisfy + {-# INLINE satisfy #-} + char = lift . char + {-# INLINE char #-} + notChar = lift . notChar + {-# INLINE notChar #-} + anyChar = lift anyChar + {-# INLINE anyChar #-} + string = lift . string + {-# INLINE string #-} + text = lift . text + {-# INLINE text #-} + +instance Parsec.Stream s m Char => CharParsing (Parsec.ParsecT s u m) where + satisfy = Parsec.satisfy + char = Parsec.char + notChar c = Parsec.satisfy (/= c) + anyChar = Parsec.anyChar + string = Parsec.string + +instance t ~ Char => CharParsing (ReadP.Parser r t) where + satisfy = ReadP.satisfy + char = ReadP.char + notChar c = ReadP.satisfy (/= c) + anyChar = ReadP.get + string = ReadP.string + +------------------------------------------------------------------------------- +-- Our additions +------------------------------------------------------------------------------- + +integral :: (CharParsing m, Integral a) => m a +integral = toNumber <$> some d "integral" + where + toNumber = foldl' (\a b -> a * 10 + b) 0 + d = f <$> satisfyRange '0' '9' + f '0' = 0 + f '1' = 1 + f '2' = 2 + f '3' = 3 + f '4' = 4 + f '5' = 5 + f '6' = 6 + f '7' = 7 + f '8' = 8 + f '9' = 9 + f _ = error "panic! integral" +{-# INLINE integral #-} + +-- | Greedily munch characters while predicate holds. +-- Require at least one character. +munch1 :: CharParsing m => (Char -> Bool) -> m String +munch1 = some . satisfy +{-# INLINE munch1 #-} + +-- | Greedely munch characters while predicate holds. +-- Always succeeds. +munch :: CharParsing m => (Char -> Bool) -> m String +munch = many . satisfy +{-# INLINE munch #-} + +skipSpaces1 :: CharParsing m => m () +skipSpaces1 = skipSome space +{-# INLINE skipSpaces1 #-} diff --git a/Cabal/Distribution/Compat/Parsec.hs b/Cabal/Distribution/Compat/Parsec.hs deleted file mode 100644 index d9d368b780e..00000000000 --- a/Cabal/Distribution/Compat/Parsec.hs +++ /dev/null @@ -1,78 +0,0 @@ -{-# LANGUAGE FlexibleContexts #-} -module Distribution.Compat.Parsec ( - P.Parsec, - P.ParsecT, - P.Stream, - (P.), - - P.runParser, - - -- * Combinators - P.between, - P.option, - P.optional, - P.optionMaybe, - P.try, - P.sepBy, - P.sepBy1, - P.choice, - P.eof, - - -- * Char - integral, - P.char, - P.anyChar, - P.satisfy, - P.space, - P.spaces, - skipSpaces1, - P.string, - munch, - munch1, - P.oneOf, - ) where - -import Distribution.Compat.Prelude -import Prelude () - -import qualified Text.Parsec as P -import qualified Text.Parsec.Pos as P - -integral :: (P.Stream s m Char, Integral a) => P.ParsecT s u m a -integral = toNumber <$> some d P. "integral" - where - toNumber = foldl' (\a b -> a * 10 + b) 0 - d = P.tokenPrim - (\c -> show [c]) - (\pos c _cs -> P.updatePosChar pos c) - f - f '0' = Just 0 - f '1' = Just 1 - f '2' = Just 2 - f '3' = Just 3 - f '4' = Just 4 - f '5' = Just 5 - f '6' = Just 6 - f '7' = Just 7 - f '8' = Just 8 - f '9' = Just 9 - f _ = Nothing - --- | Greedily munch characters while predicate holds. --- Require at least one character. -munch1 - :: P.Stream s m Char - => (Char -> Bool) - -> P.ParsecT s u m String -munch1 = some . P.satisfy - --- | Greedely munch characters while predicate holds. --- Always succeeds. -munch - :: P.Stream s m Char - => (Char -> Bool) - -> P.ParsecT s u m String -munch = many . P.satisfy - -skipSpaces1 :: P.Stream s m Char => P.ParsecT s u m () -skipSpaces1 = P.skipMany1 P.space diff --git a/Cabal/Distribution/Compat/Parsing.hs b/Cabal/Distribution/Compat/Parsing.hs new file mode 100644 index 00000000000..bd5c39eb269 --- /dev/null +++ b/Cabal/Distribution/Compat/Parsing.hs @@ -0,0 +1,403 @@ +{-# LANGUAGE GADTs, UndecidableInstances #-} +----------------------------------------------------------------------------- +-- | +-- Module : Distribution.Compat.Parsing +-- Copyright : (c) Edward Kmett 2011-2012 +-- License : BSD3 +-- +-- Maintainer : ekmett@gmail.com +-- Stability : experimental +-- Portability : non-portable +-- +-- Alternative parser combinators. +-- +-- Originally in @parsers@ package. +-- +----------------------------------------------------------------------------- +module Distribution.Compat.Parsing + ( + -- * Parsing Combinators + choice + , option + , optional -- from Control.Applicative, parsec optionMaybe + , skipOptional -- parsec optional + , between + , some -- from Control.Applicative, parsec many1 + , many -- from Control.Applicative + , sepBy + , sepBy1 + -- , sepByNonEmpty + , sepEndBy1 + -- , sepEndByNonEmpty + , sepEndBy + , endBy1 + -- , endByNonEmpty + , endBy + , count + , chainl + , chainr + , chainl1 + , chainr1 + , manyTill + -- * Parsing Class + , Parsing(..) + ) where + +import Prelude () +import Distribution.Compat.Prelude + +import Control.Applicative ((<**>), optional) +import Control.Monad.Trans.Class (lift) +import Control.Monad.Trans.State.Lazy as Lazy +import Control.Monad.Trans.State.Strict as Strict +import Control.Monad.Trans.Writer.Lazy as Lazy +import Control.Monad.Trans.Writer.Strict as Strict +import Control.Monad.Trans.RWS.Lazy as Lazy +import Control.Monad.Trans.RWS.Strict as Strict +import Control.Monad.Trans.Reader (ReaderT (..)) +import Control.Monad.Trans.Identity (IdentityT (..)) +import Data.Foldable (asum) + +import qualified Text.Parsec as Parsec +import qualified Distribution.Compat.ReadP as ReadP + +-- | @choice ps@ tries to apply the parsers in the list @ps@ in order, +-- until one of them succeeds. Returns the value of the succeeding +-- parser. +choice :: Alternative m => [m a] -> m a +choice = asum +{-# INLINE choice #-} + +-- | @option x p@ tries to apply parser @p@. If @p@ fails without +-- consuming input, it returns the value @x@, otherwise the value +-- returned by @p@. +-- +-- > priority = option 0 (digitToInt <$> digit) +option :: Alternative m => a -> m a -> m a +option x p = p <|> pure x +{-# INLINE option #-} + +-- | @skipOptional p@ tries to apply parser @p@. It will parse @p@ or nothing. +-- It only fails if @p@ fails after consuming input. It discards the result +-- of @p@. (Plays the role of parsec's optional, which conflicts with Applicative's optional) +skipOptional :: Alternative m => m a -> m () +skipOptional p = (() <$ p) <|> pure () +{-# INLINE skipOptional #-} + +-- | @between open close p@ parses @open@, followed by @p@ and @close@. +-- Returns the value returned by @p@. +-- +-- > braces = between (symbol "{") (symbol "}") +between :: Applicative m => m bra -> m ket -> m a -> m a +between bra ket p = bra *> p <* ket +{-# INLINE between #-} + +-- | @sepBy p sep@ parses /zero/ or more occurrences of @p@, separated +-- by @sep@. Returns a list of values returned by @p@. +-- +-- > commaSep p = p `sepBy` (symbol ",") +sepBy :: Alternative m => m a -> m sep -> m [a] +sepBy p sep = sepBy1 p sep <|> pure [] +{-# INLINE sepBy #-} + +-- | @sepBy1 p sep@ parses /one/ or more occurrences of @p@, separated +-- by @sep@. Returns a list of values returned by @p@. +sepBy1 :: Alternative m => m a -> m sep -> m [a] +sepBy1 p sep = (:) <$> p <*> many (sep *> p) +-- toList <$> sepByNonEmpty p sep +{-# INLINE sepBy1 #-} + +{- +-- | @sepByNonEmpty p sep@ parses /one/ or more occurrences of @p@, separated +-- by @sep@. Returns a non-empty list of values returned by @p@. +sepByNonEmpty :: Alternative m => m a -> m sep -> m (NonEmpty a) +sepByNonEmpty p sep = (:|) <$> p <*> many (sep *> p) +{-# INLINE sepByNonEmpty #-} +-} + +-- | @sepEndBy1 p sep@ parses /one/ or more occurrences of @p@, +-- separated and optionally ended by @sep@. Returns a list of values +-- returned by @p@. +sepEndBy1 :: Alternative m => m a -> m sep -> m [a] +sepEndBy1 p sep = (:) <$> p <*> ((sep *> sepEndBy p sep) <|> pure []) +-- toList <$> sepEndByNonEmpty p sep + +{- +-- | @sepEndByNonEmpty p sep@ parses /one/ or more occurrences of @p@, +-- separated and optionally ended by @sep@. Returns a non-empty list of values +-- returned by @p@. +sepEndByNonEmpty :: Alternative m => m a -> m sep -> m (NonEmpty a) +sepEndByNonEmpty p sep = (:|) <$> p <*> ((sep *> sepEndBy p sep) <|> pure []) +-} + +-- | @sepEndBy p sep@ parses /zero/ or more occurrences of @p@, +-- separated and optionally ended by @sep@, ie. haskell style +-- statements. Returns a list of values returned by @p@. +-- +-- > haskellStatements = haskellStatement `sepEndBy` semi +sepEndBy :: Alternative m => m a -> m sep -> m [a] +sepEndBy p sep = sepEndBy1 p sep <|> pure [] +{-# INLINE sepEndBy #-} + +-- | @endBy1 p sep@ parses /one/ or more occurrences of @p@, separated +-- and ended by @sep@. Returns a list of values returned by @p@. +endBy1 :: Alternative m => m a -> m sep -> m [a] +endBy1 p sep = some (p <* sep) +{-# INLINE endBy1 #-} + +{- +-- | @endByNonEmpty p sep@ parses /one/ or more occurrences of @p@, separated +-- and ended by @sep@. Returns a non-empty list of values returned by @p@. +endByNonEmpty :: Alternative m => m a -> m sep -> m (NonEmpty a) +endByNonEmpty p sep = some1 (p <* sep) +{-# INLINE endByNonEmpty #-} +-} + +-- | @endBy p sep@ parses /zero/ or more occurrences of @p@, separated +-- and ended by @sep@. Returns a list of values returned by @p@. +-- +-- > cStatements = cStatement `endBy` semi +endBy :: Alternative m => m a -> m sep -> m [a] +endBy p sep = many (p <* sep) +{-# INLINE endBy #-} + +-- | @count n p@ parses @n@ occurrences of @p@. If @n@ is smaller or +-- equal to zero, the parser equals to @return []@. Returns a list of +-- @n@ values returned by @p@. +count :: Applicative m => Int -> m a -> m [a] +count n p | n <= 0 = pure [] + | otherwise = sequenceA (replicate n p) +{-# INLINE count #-} + +-- | @chainr p op x@ parses /zero/ or more occurrences of @p@, +-- separated by @op@ Returns a value obtained by a /right/ associative +-- application of all functions returned by @op@ to the values returned +-- by @p@. If there are no occurrences of @p@, the value @x@ is +-- returned. +chainr :: Alternative m => m a -> m (a -> a -> a) -> a -> m a +chainr p op x = chainr1 p op <|> pure x +{-# INLINE chainr #-} + +-- | @chainl p op x@ parses /zero/ or more occurrences of @p@, +-- separated by @op@. Returns a value obtained by a /left/ associative +-- application of all functions returned by @op@ to the values returned +-- by @p@. If there are zero occurrences of @p@, the value @x@ is +-- returned. +chainl :: Alternative m => m a -> m (a -> a -> a) -> a -> m a +chainl p op x = chainl1 p op <|> pure x +{-# INLINE chainl #-} + +-- | @chainl1 p op x@ parses /one/ or more occurrences of @p@, +-- separated by @op@ Returns a value obtained by a /left/ associative +-- application of all functions returned by @op@ to the values returned +-- by @p@. . This parser can for example be used to eliminate left +-- recursion which typically occurs in expression grammars. +-- +-- > expr = term `chainl1` addop +-- > term = factor `chainl1` mulop +-- > factor = parens expr <|> integer +-- > +-- > mulop = (*) <$ symbol "*" +-- > <|> div <$ symbol "/" +-- > +-- > addop = (+) <$ symbol "+" +-- > <|> (-) <$ symbol "-" +chainl1 :: Alternative m => m a -> m (a -> a -> a) -> m a +chainl1 p op = scan where + scan = p <**> rst + rst = (\f y g x -> g (f x y)) <$> op <*> p <*> rst <|> pure id +{-# INLINE chainl1 #-} + +-- | @chainr1 p op x@ parses /one/ or more occurrences of @p@, +-- separated by @op@ Returns a value obtained by a /right/ associative +-- application of all functions returned by @op@ to the values returned +-- by @p@. +chainr1 :: Alternative m => m a -> m (a -> a -> a) -> m a +chainr1 p op = scan where + scan = p <**> rst + rst = (flip <$> op <*> scan) <|> pure id +{-# INLINE chainr1 #-} + +-- | @manyTill p end@ applies parser @p@ /zero/ or more times until +-- parser @end@ succeeds. Returns the list of values returned by @p@. +-- This parser can be used to scan comments: +-- +-- > simpleComment = do{ string "")) +-- > } +-- +-- Note the overlapping parsers @anyChar@ and @string \"-->\"@, and +-- therefore the use of the 'try' combinator. +manyTill :: Alternative m => m a -> m end -> m [a] +manyTill p end = go where go = ([] <$ end) <|> ((:) <$> p <*> go) +{-# INLINE manyTill #-} + +infixr 0 + +-- | Additional functionality needed to describe parsers independent of input type. +class Alternative m => Parsing m where + -- | Take a parser that may consume input, and on failure, go back to + -- where we started and fail as if we didn't consume input. + try :: m a -> m a + + -- | Give a parser a name + () :: m a -> String -> m a + + -- | A version of many that discards its input. Specialized because it + -- can often be implemented more cheaply. + skipMany :: m a -> m () + skipMany p = () <$ many p + {-# INLINE skipMany #-} + + -- | @skipSome p@ applies the parser @p@ /one/ or more times, skipping + -- its result. (aka skipMany1 in parsec) + skipSome :: m a -> m () + skipSome p = p *> skipMany p + {-# INLINE skipSome #-} + + -- | Used to emit an error on an unexpected token + unexpected :: String -> m a + + -- | This parser only succeeds at the end of the input. This is not a + -- primitive parser but it is defined using 'notFollowedBy'. + -- + -- > eof = notFollowedBy anyChar "end of input" + eof :: m () + + -- | @notFollowedBy p@ only succeeds when parser @p@ fails. This parser + -- does not consume any input. This parser can be used to implement the + -- \'longest match\' rule. For example, when recognizing keywords (for + -- example @let@), we want to make sure that a keyword is not followed + -- by a legal identifier character, in which case the keyword is + -- actually an identifier (for example @lets@). We can program this + -- behaviour as follows: + -- + -- > keywordLet = try $ string "let" <* notFollowedBy alphaNum + notFollowedBy :: Show a => m a -> m () + +instance (Parsing m, MonadPlus m) => Parsing (Lazy.StateT s m) where + try (Lazy.StateT m) = Lazy.StateT $ try . m + {-# INLINE try #-} + Lazy.StateT m l = Lazy.StateT $ \s -> m s l + {-# INLINE () #-} + unexpected = lift . unexpected + {-# INLINE unexpected #-} + eof = lift eof + {-# INLINE eof #-} + notFollowedBy (Lazy.StateT m) = Lazy.StateT + $ \s -> notFollowedBy (fst <$> m s) >> return ((),s) + {-# INLINE notFollowedBy #-} + +instance (Parsing m, MonadPlus m) => Parsing (Strict.StateT s m) where + try (Strict.StateT m) = Strict.StateT $ try . m + {-# INLINE try #-} + Strict.StateT m l = Strict.StateT $ \s -> m s l + {-# INLINE () #-} + unexpected = lift . unexpected + {-# INLINE unexpected #-} + eof = lift eof + {-# INLINE eof #-} + notFollowedBy (Strict.StateT m) = Strict.StateT + $ \s -> notFollowedBy (fst <$> m s) >> return ((),s) + {-# INLINE notFollowedBy #-} + +instance (Parsing m, MonadPlus m) => Parsing (ReaderT e m) where + try (ReaderT m) = ReaderT $ try . m + {-# INLINE try #-} + ReaderT m l = ReaderT $ \e -> m e l + {-# INLINE () #-} + skipMany (ReaderT m) = ReaderT $ skipMany . m + {-# INLINE skipMany #-} + unexpected = lift . unexpected + {-# INLINE unexpected #-} + eof = lift eof + {-# INLINE eof #-} + notFollowedBy (ReaderT m) = ReaderT $ notFollowedBy . m + {-# INLINE notFollowedBy #-} + +instance (Parsing m, MonadPlus m, Monoid w) => Parsing (Strict.WriterT w m) where + try (Strict.WriterT m) = Strict.WriterT $ try m + {-# INLINE try #-} + Strict.WriterT m l = Strict.WriterT (m l) + {-# INLINE () #-} + unexpected = lift . unexpected + {-# INLINE unexpected #-} + eof = lift eof + {-# INLINE eof #-} + notFollowedBy (Strict.WriterT m) = Strict.WriterT + $ notFollowedBy (fst <$> m) >>= \x -> return (x, mempty) + {-# INLINE notFollowedBy #-} + +instance (Parsing m, MonadPlus m, Monoid w) => Parsing (Lazy.WriterT w m) where + try (Lazy.WriterT m) = Lazy.WriterT $ try m + {-# INLINE try #-} + Lazy.WriterT m l = Lazy.WriterT (m l) + {-# INLINE () #-} + unexpected = lift . unexpected + {-# INLINE unexpected #-} + eof = lift eof + {-# INLINE eof #-} + notFollowedBy (Lazy.WriterT m) = Lazy.WriterT + $ notFollowedBy (fst <$> m) >>= \x -> return (x, mempty) + {-# INLINE notFollowedBy #-} + +instance (Parsing m, MonadPlus m, Monoid w) => Parsing (Lazy.RWST r w s m) where + try (Lazy.RWST m) = Lazy.RWST $ \r s -> try (m r s) + {-# INLINE try #-} + Lazy.RWST m l = Lazy.RWST $ \r s -> m r s l + {-# INLINE () #-} + unexpected = lift . unexpected + {-# INLINE unexpected #-} + eof = lift eof + {-# INLINE eof #-} + notFollowedBy (Lazy.RWST m) = Lazy.RWST + $ \r s -> notFollowedBy ((\(a,_,_) -> a) <$> m r s) >>= \x -> return (x, s, mempty) + {-# INLINE notFollowedBy #-} + +instance (Parsing m, MonadPlus m, Monoid w) => Parsing (Strict.RWST r w s m) where + try (Strict.RWST m) = Strict.RWST $ \r s -> try (m r s) + {-# INLINE try #-} + Strict.RWST m l = Strict.RWST $ \r s -> m r s l + {-# INLINE () #-} + unexpected = lift . unexpected + {-# INLINE unexpected #-} + eof = lift eof + {-# INLINE eof #-} + notFollowedBy (Strict.RWST m) = Strict.RWST + $ \r s -> notFollowedBy ((\(a,_,_) -> a) <$> m r s) >>= \x -> return (x, s, mempty) + {-# INLINE notFollowedBy #-} + +instance (Parsing m, Monad m) => Parsing (IdentityT m) where + try = IdentityT . try . runIdentityT + {-# INLINE try #-} + IdentityT m l = IdentityT (m l) + {-# INLINE () #-} + skipMany = IdentityT . skipMany . runIdentityT + {-# INLINE skipMany #-} + unexpected = lift . unexpected + {-# INLINE unexpected #-} + eof = lift eof + {-# INLINE eof #-} + notFollowedBy (IdentityT m) = IdentityT $ notFollowedBy m + {-# INLINE notFollowedBy #-} + +instance (Parsec.Stream s m t, Show t) => Parsing (Parsec.ParsecT s u m) where + try = Parsec.try + () = (Parsec.) + skipMany = Parsec.skipMany + skipSome = Parsec.skipMany1 + unexpected = Parsec.unexpected + eof = Parsec.eof + notFollowedBy = Parsec.notFollowedBy + +instance t ~ Char => Parsing (ReadP.Parser r t) where + try = id + () = const + skipMany = ReadP.skipMany + skipSome = ReadP.skipMany1 + unexpected = const ReadP.pfail + eof = ReadP.eof + + -- TODO: we would like to have <++ here + notFollowedBy p = ((Just <$> p) ReadP.+++ pure Nothing) + >>= maybe (pure ()) (unexpected . show) diff --git a/Cabal/Distribution/Compat/ReadP.hs b/Cabal/Distribution/Compat/ReadP.hs index a9c79c891d9..1f5a989572f 100644 --- a/Cabal/Distribution/Compat/ReadP.hs +++ b/Cabal/Distribution/Compat/ReadP.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE GADTs #-} ----------------------------------------------------------------------------- -- | -- Module : Distribution.Compat.ReadP @@ -69,21 +70,18 @@ module Distribution.Compat.ReadP readP_to_S, -- :: ReadP a -> ReadS a readS_to_P, -- :: ReadS a -> ReadP a - -- ** Parsec - parsecToReadP, + -- ** Internal + Parser, ) where import Prelude () import Distribution.Compat.Prelude hiding (many, get) -import Control.Applicative (liftA2) import qualified Distribution.Compat.MonadFail as Fail import Control.Monad( replicateM, (>=>) ) -import qualified Text.Parsec as P - infixr 5 +++, <++ -- --------------------------------------------------------------------------- @@ -168,6 +166,10 @@ instance Applicative (Parser r s) where pure x = R (\k -> k x) (<*>) = ap +instance s ~ Char => Alternative (Parser r s) where + empty = pfail + (<|>) = (+++) + instance Monad (Parser r s) where return = pure fail = Fail.fail @@ -176,9 +178,9 @@ instance Monad (Parser r s) where instance Fail.MonadFail (Parser r s) where fail _ = R (const Fail) ---instance MonadPlus (Parser r s) where --- mzero = pfail --- mplus = (+++) +instance s ~ Char => MonadPlus (Parser r s) where + mzero = pfail + mplus = (+++) -- --------------------------------------------------------------------------- -- Operations over P @@ -420,16 +422,3 @@ readS_to_P :: ReadS a -> ReadP r a -- parser, and therefore a possible inefficiency. readS_to_P r = R (\k -> Look (\s -> final [bs'' | (a,s') <- r s, bs'' <- run (k a) s'])) - --- --------------------------------------------------------------------------- --- Converting from Parsec to ReadP --- --- | Convert @Parsec@ parser to 'ReadP'. -parsecToReadP - :: P.Parsec [Char] u a - -> u -- ^ initial user state - -> ReadP r a -parsecToReadP p u = R $ \k -> Look $ \s -> - case P.runParser (liftA2 (,) p P.getInput) u "" s of - Right (x, s') -> final (run (k x) s') - Left _ -> Fail diff --git a/Cabal/Distribution/Compiler.hs b/Cabal/Distribution/Compiler.hs index b6a26754ec2..2f77b811302 100644 --- a/Cabal/Distribution/Compiler.hs +++ b/Cabal/Distribution/Compiler.hs @@ -55,7 +55,7 @@ import Distribution.Parsec.Class (Parsec (..)) import Distribution.Pretty (Pretty (..)) import Distribution.Text (Text(..), display) import qualified Distribution.Compat.ReadP as Parse -import qualified Distribution.Compat.Parsec as P +import qualified Distribution.Compat.CharParsing as P import qualified Text.PrettyPrint as Disp data CompilerFlavor = diff --git a/Cabal/Distribution/FieldGrammar/Class.hs b/Cabal/Distribution/FieldGrammar/Class.hs index 853fec2a2f9..d1622abfb84 100644 --- a/Cabal/Distribution/FieldGrammar/Class.hs +++ b/Cabal/Distribution/FieldGrammar/Class.hs @@ -90,6 +90,7 @@ class FieldGrammar g where -- | Annotate field with since spec-version. availableSince :: [Int] -- ^ spec version + -> a -- ^ default value -> g s a -> g s a diff --git a/Cabal/Distribution/FieldGrammar/Parsec.hs b/Cabal/Distribution/FieldGrammar/Parsec.hs index bf72f8f3e9a..fc9f2d27ba2 100644 --- a/Cabal/Distribution/FieldGrammar/Parsec.hs +++ b/Cabal/Distribution/FieldGrammar/Parsec.hs @@ -1,5 +1,6 @@ -{-# LANGUAGE DeriveFunctor #-} -{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE DeriveFunctor #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} -- | This module provides a 'FieldGrammarParser', one way to parse -- @.cabal@ -like files. -- @@ -61,19 +62,21 @@ module Distribution.FieldGrammar.Parsec ( runFieldParser', ) where +import Data.List (dropWhileEnd) +import Data.Ord (comparing) +import Data.Set (Set) +import Distribution.Compat.Newtype +import Distribution.Compat.Prelude +import Distribution.Simple.Utils (fromUTF8BS) +import Prelude () + import qualified Data.ByteString as BS -import Data.List (dropWhileEnd) -import Data.Ord (comparing) -import Data.Set (Set) import qualified Data.Set as Set import qualified Distribution.Compat.Map.Strict as Map -import Distribution.Compat.Prelude -import Distribution.Compat.Newtype -import Distribution.Simple.Utils (fromUTF8BS) -import Prelude () import qualified Text.Parsec as P import qualified Text.Parsec.Error as P +import Distribution.CabalSpecVersion import Distribution.FieldGrammar.Class import Distribution.Parsec.Class import Distribution.Parsec.Common @@ -101,19 +104,19 @@ data Section ann = MkSection !(Name ann) [SectionArg ann] [Field ann] data ParsecFieldGrammar s a = ParsecFG { fieldGrammarKnownFields :: !(Set FieldName) , fieldGrammarKnownPrefixes :: !(Set FieldName) - , fieldGrammarParser :: !(Fields Position -> ParseResult a) + , fieldGrammarParser :: !(CabalSpecVersion -> Fields Position -> ParseResult a) } deriving (Functor) -parseFieldGrammar :: Fields Position -> ParsecFieldGrammar s a -> ParseResult a -parseFieldGrammar fields grammar = do +parseFieldGrammar :: CabalSpecVersion -> Fields Position -> ParsecFieldGrammar s a -> ParseResult a +parseFieldGrammar v fields grammar = do for_ (Map.toList (Map.filterWithKey isUnknownField fields)) $ \(name, nfields) -> for_ nfields $ \(MkNamelessField pos _) -> parseWarning pos PWTUnknownField $ "Unknown field: " ++ show name -- TODO: fields allowed in this section -- parse - fieldGrammarParser grammar fields + fieldGrammarParser grammar v fields where isUnknownField k _ = not $ @@ -124,13 +127,13 @@ fieldGrammarKnownFieldList :: ParsecFieldGrammar s a -> [FieldName] fieldGrammarKnownFieldList = Set.toList . fieldGrammarKnownFields instance Applicative (ParsecFieldGrammar s) where - pure x = ParsecFG mempty mempty (\_ -> pure x) + pure x = ParsecFG mempty mempty (\_ _ -> pure x) {-# INLINE pure #-} ParsecFG f f' f'' <*> ParsecFG x x' x'' = ParsecFG (mappend f x) (mappend f' x') - (\fields -> f'' fields <*> x'' fields) + (\v fields -> f'' v fields <*> x'' v fields) {-# INLINE (<*>) #-} instance FieldGrammar ParsecFieldGrammar where @@ -138,52 +141,51 @@ instance FieldGrammar ParsecFieldGrammar where uniqueFieldAla fn _pack _extract = ParsecFG (Set.singleton fn) Set.empty parser where - parser fields = case Map.lookup fn fields of + parser v fields = case Map.lookup fn fields of Nothing -> parseFatalFailure zeroPos $ show fn ++ " field missing:" Just [] -> parseFatalFailure zeroPos $ show fn ++ " field foo" - Just [x] -> parseOne x + Just [x] -> parseOne v x -- TODO: parse all -- TODO: warn about duplicate fields? - Just xs-> parseOne (last xs) + Just xs-> parseOne v (last xs) - parseOne (MkNamelessField pos fls) = - unpack' _pack <$> runFieldParser pos parsec fls + parseOne v (MkNamelessField pos fls) = + unpack' _pack <$> runFieldParser pos parsec v fls booleanFieldDef fn _extract def = ParsecFG (Set.singleton fn) Set.empty parser where - parser :: Fields Position -> ParseResult Bool - parser fields = case Map.lookup fn fields of + parser v fields = case Map.lookup fn fields of Nothing -> pure def Just [] -> pure def - Just [x] -> parseOne x + Just [x] -> parseOne v x -- TODO: parse all -- TODO: warn about duplicate optional fields? - Just xs -> parseOne (last xs) + Just xs -> parseOne v (last xs) - parseOne (MkNamelessField pos fls) = runFieldParser pos parsec fls + parseOne v (MkNamelessField pos fls) = runFieldParser pos parsec v fls optionalFieldAla fn _pack _extract = ParsecFG (Set.singleton fn) Set.empty parser where - parser fields = case Map.lookup fn fields of + parser v fields = case Map.lookup fn fields of Nothing -> pure Nothing Just [] -> pure Nothing - Just [x] -> parseOne x + Just [x] -> parseOne v x -- TODO: parse all! - Just xs -> parseOne (last xs) -- TODO: warn about duplicate optional fields? + Just xs -> parseOne v (last xs) -- TODO: warn about duplicate optional fields? - parseOne (MkNamelessField pos fls) + parseOne v (MkNamelessField pos fls) | null fls = pure Nothing - | otherwise = Just . (unpack' _pack) <$> runFieldParser pos parsec fls + | otherwise = Just . (unpack' _pack) <$> runFieldParser pos parsec v fls monoidalFieldAla fn _pack _extract = ParsecFG (Set.singleton fn) Set.empty parser where - parser fields = case Map.lookup fn fields of + parser v fields = case Map.lookup fn fields of Nothing -> pure mempty - Just xs -> foldMap (unpack' _pack) <$> traverse parseOne xs + Just xs -> foldMap (unpack' _pack) <$> traverse (parseOne v) xs - parseOne (MkNamelessField pos fls) = runFieldParser pos parsec fls + parseOne v (MkNamelessField pos fls) = runFieldParser pos parsec v fls - prefixedFields fnPfx _extract = ParsecFG mempty (Set.singleton fnPfx) (pure . parser) + prefixedFields fnPfx _extract = ParsecFG mempty (Set.singleton fnPfx) (\_ fs -> pure (parser fs)) where parser :: Fields Position -> [(String, String)] parser values = reorder $ concatMap convert $ filter match $ Map.toList values @@ -199,21 +201,33 @@ instance FieldGrammar ParsecFieldGrammar where trim :: String -> String trim = dropWhile isSpace . dropWhileEnd isSpace - availableSince _ = id - + availableSince vs def (ParsecFG names prefixes parser) = ParsecFG names prefixes parser' + where + parser' v values + | cabalSpecSupports v vs = parser v values + | otherwise = do + let unknownFields = Map.intersection values $ Map.fromSet (const ()) names + for_ (Map.toList unknownFields) $ \(name, fields) -> + for_ fields $ \(MkNamelessField pos _) -> + parseWarning pos PWTUnknownField $ + "The field " <> show name <> " is available since Cabal " ++ show vs + + pure def + + -- todo we know about this field deprecatedSince (_ : _) _ grammar = grammar -- pass on non-empty version deprecatedSince _ msg (ParsecFG names prefixes parser) = ParsecFG names prefixes parser' where - parser' values = do + parser' v values = do let deprecatedFields = Map.intersection values $ Map.fromSet (const ()) names for_ (Map.toList deprecatedFields) $ \(name, fields) -> for_ fields $ \(MkNamelessField pos _) -> parseWarning pos PWTDeprecatedField $ "The field " <> show name <> " is deprecated. " ++ msg - parser values + parser v values - knownField fn = ParsecFG (Set.singleton fn) Set.empty (\_ -> pure ()) + knownField fn = ParsecFG (Set.singleton fn) Set.empty (\_ _ -> pure ()) hiddenField = id @@ -221,8 +235,8 @@ instance FieldGrammar ParsecFieldGrammar where -- Parsec ------------------------------------------------------------------------------- -runFieldParser' :: Position -> FieldParser a -> String -> ParseResult a -runFieldParser' (Position row col) p str = case P.runParser p' [] "" str of +runFieldParser' :: Position -> ParsecParser a -> CabalSpecVersion -> String -> ParseResult a +runFieldParser' (Position row col) p v str = case P.runParser p' [] "" str of Right (pok, ws) -> do -- TODO: map pos traverse_ (\(PWarning t pos w) -> parseWarning pos t w) ws @@ -237,10 +251,10 @@ runFieldParser' (Position row col) p str = case P.runParser p' [] "" str parseFatalFailure epos $ msg ++ ": " ++ show str where - p' = (,) <$ P.spaces <*> p <* P.spaces <* P.eof <*> P.getState + p' = (,) <$ P.spaces <*> unPP p v <* P.spaces <* P.eof <*> P.getState -runFieldParser :: Position -> FieldParser a -> [FieldLine Position] -> ParseResult a -runFieldParser pp p ls = runFieldParser' pos p =<< fieldlinesToString pos ls +runFieldParser :: Position -> ParsecParser a -> CabalSpecVersion -> [FieldLine Position] -> ParseResult a +runFieldParser pp p v ls = runFieldParser' pos p v =<< fieldlinesToString pos ls where -- TODO: make per line lookup pos = case ls of diff --git a/Cabal/Distribution/FieldGrammar/Pretty.hs b/Cabal/Distribution/FieldGrammar/Pretty.hs index 865ba108684..d42b9dd5656 100644 --- a/Cabal/Distribution/FieldGrammar/Pretty.hs +++ b/Cabal/Distribution/FieldGrammar/Pretty.hs @@ -66,5 +66,5 @@ instance FieldGrammar PrettyFieldGrammar where knownField _ = pure () deprecatedSince [] _ _ = PrettyFG (\_ -> mempty) deprecatedSince _ _ x = x - availableSince _ = id + availableSince _ _ = id hiddenField _ = PrettyFG (\_ -> mempty) diff --git a/Cabal/Distribution/License.hs b/Cabal/Distribution/License.hs index c40c605405e..4fe4c0baa23 100644 --- a/Cabal/Distribution/License.hs +++ b/Cabal/Distribution/License.hs @@ -55,9 +55,9 @@ import Distribution.Pretty import Distribution.Text import Distribution.Version -import qualified Distribution.Compat.Parsec as P -import qualified Distribution.Compat.ReadP as Parse -import qualified Text.PrettyPrint as Disp +import qualified Distribution.Compat.CharParsing as P +import qualified Distribution.Compat.ReadP as Parse +import qualified Text.PrettyPrint as Disp -- | Indicates the license under which a package's source code is released. -- Versions of the licenses not listed here will be rejected by Hackage and @@ -152,7 +152,7 @@ instance Pretty License where instance Parsec License where parsec = do name <- P.munch1 isAlphaNum - version <- P.optionMaybe (P.char '-' *> parsec) + version <- P.optional (P.char '-' *> parsec) return $! case (name, version :: Maybe Version) of ("GPL", _ ) -> GPL version ("LGPL", _ ) -> LGPL version diff --git a/Cabal/Distribution/ModuleName.hs b/Cabal/Distribution/ModuleName.hs index 2e5ae5d9daf..9f1cbbc5970 100644 --- a/Cabal/Distribution/ModuleName.hs +++ b/Cabal/Distribution/ModuleName.hs @@ -34,8 +34,8 @@ import Distribution.Pretty import Distribution.Parsec.Class import Distribution.Text -import qualified Distribution.Compat.Parsec as P -import qualified Distribution.Compat.ReadP as Parse +import qualified Distribution.Compat.CharParsing as P +import qualified Distribution.Compat.ReadP as Parse import qualified Text.PrettyPrint as Disp -- | A valid Haskell module name. diff --git a/Cabal/Distribution/PackageDescription/FieldGrammar.hs b/Cabal/Distribution/PackageDescription/FieldGrammar.hs index ae65b0bd8b8..21d3a22d700 100644 --- a/Cabal/Distribution/PackageDescription/FieldGrammar.hs +++ b/Cabal/Distribution/PackageDescription/FieldGrammar.hs @@ -125,6 +125,7 @@ libraryFieldGrammar n = Library n <$> monoidalFieldAla "exposed-modules" (alaList' VCat MQuoted) L.exposedModules <*> monoidalFieldAla "reexported-modules" (alaList CommaVCat) L.reexportedModules <*> monoidalFieldAla "signatures" (alaList' VCat MQuoted) L.signatures + ^^^ availableSince [2,0] [] <*> booleanFieldDef "exposed" L.libExposed True <*> blurFieldGrammar L.libBuildInfo buildInfoFieldGrammar {-# SPECIALIZE libraryFieldGrammar :: Maybe UnqualComponentName -> ParsecFieldGrammar' Library #-} @@ -364,7 +365,11 @@ buildInfoFieldGrammar = BuildInfo <*> monoidalFieldAla "build-tools" (alaList CommaFSep) L.buildTools ^^^ deprecatedSince [2,0] "Please use 'build-tool-depends' field" <*> monoidalFieldAla "build-tool-depends" (alaList CommaFSep) L.buildToolDepends - ^^^ availableSince [2,0] + -- {- ^^^ availableSince [2,0] [] -} + -- here, we explicitly want to recognise build-tool-depends for all Cabal files + -- as otherwise cabal new-build cannot really work. + -- + -- I.e. we don't want trigger unknown field warning <*> monoidalFieldAla "cpp-options" (alaList' NoCommaFSep Token') L.cppOptions <*> monoidalFieldAla "asm-options" (alaList' NoCommaFSep Token') L.asmOptions <*> monoidalFieldAla "cmm-options" (alaList' NoCommaFSep Token') L.cmmOptions @@ -404,6 +409,7 @@ buildInfoFieldGrammar = BuildInfo <*> prefixedFields "x-" L.customFieldsBI <*> monoidalFieldAla "build-depends" (alaList CommaVCat) L.targetBuildDepends <*> monoidalFieldAla "mixins" (alaList CommaVCat) L.mixins + ^^^ availableSince [2,0] [] {-# SPECIALIZE buildInfoFieldGrammar :: ParsecFieldGrammar' BuildInfo #-} {-# SPECIALIZE buildInfoFieldGrammar :: PrettyFieldGrammar' BuildInfo #-} diff --git a/Cabal/Distribution/PackageDescription/Parsec.hs b/Cabal/Distribution/PackageDescription/Parsec.hs index 57d632aa39f..368d64d30db 100644 --- a/Cabal/Distribution/PackageDescription/Parsec.hs +++ b/Cabal/Distribution/PackageDescription/Parsec.hs @@ -33,36 +33,38 @@ module Distribution.PackageDescription.Parsec ( import Distribution.Compat.Prelude import Prelude () -import Control.Monad.State.Strict (StateT, execStateT) -import Control.Monad.Trans.Class (lift) -import qualified Data.ByteString as BS -import Data.List (partition) -import qualified Distribution.Compat.Map.Strict as Map -import Distribution.FieldGrammar -import Distribution.PackageDescription -import Distribution.PackageDescription.FieldGrammar -import Distribution.PackageDescription.Quirks (patchQuirks) -import Distribution.Parsec.Class (parsecCommaList, parsec, parsecToken) -import Distribution.Parsec.Common -import Distribution.Parsec.ConfVar (parseConditionConfVar) -import Distribution.Parsec.Field (FieldName, getName) -import Distribution.Parsec.LexerMonad (LexWarning, toPWarning) -import Distribution.Parsec.Parser -import Distribution.Parsec.ParseResult -import Distribution.Simple.Utils (die', fromUTF8BS, warn) -import Distribution.Text (display) -import Distribution.Types.CondTree -import Distribution.Types.Dependency (Dependency) -import Distribution.Types.ForeignLib -import Distribution.Types.UnqualComponentName - (UnqualComponentName, mkUnqualComponentName) -import Distribution.Utils.Generic (breakMaybe, unfoldrM) -import Distribution.Verbosity (Verbosity) -import Distribution.Version - (LowerBound (..), Version, asVersionIntervals, mkVersion, orLaterVersion) -import System.Directory (doesFileExist) - -import Distribution.Compat.Lens +import Control.Monad.State.Strict (StateT, execStateT) +import Control.Monad.Trans.Class (lift) +import Data.List (partition) +import Distribution.CabalSpecVersion +import Distribution.Compat.Lens +import Distribution.FieldGrammar +import Distribution.PackageDescription +import Distribution.PackageDescription.FieldGrammar +import Distribution.PackageDescription.Quirks (patchQuirks) +import Distribution.Parsec.Class (parsec) +import Distribution.Parsec.Common +import Distribution.Parsec.ConfVar (parseConditionConfVar) +import Distribution.Parsec.Field (FieldName, getName) +import Distribution.Parsec.LexerMonad (LexWarning, toPWarning) +import Distribution.Parsec.Newtypes (CommaFSep, List, Token) +import Distribution.Parsec.Parser +import Distribution.Parsec.ParseResult +import Distribution.Simple.Utils (die', fromUTF8BS, warn) +import Distribution.Text (display) +import Distribution.Types.CondTree +import Distribution.Types.Dependency (Dependency) +import Distribution.Types.ForeignLib +import Distribution.Types.UnqualComponentName (UnqualComponentName, mkUnqualComponentName) +import Distribution.Utils.Generic (breakMaybe, unfoldrM) +import Distribution.Verbosity (Verbosity) +import Distribution.Version + (LowerBound (..), Version, asVersionIntervals, mkVersion, orLaterVersion) +import System.Directory (doesFileExist) + +import qualified Data.ByteString as BS +import qualified Distribution.Compat.Map.Strict as Map +import qualified Distribution.Compat.Newtype as Newtype import qualified Distribution.Types.BuildInfo.Lens as L import qualified Distribution.Types.GenericPackageDescription.Lens as L import qualified Distribution.Types.PackageDescription.Lens as L @@ -157,16 +159,18 @@ parseGenericPackageDescription' lexWarnings fs = do -- PackageDescription let (fields, sectionFields) = takeFields fs' - pd <- parseFieldGrammar fields packageDescriptionFieldGrammar + pd <- parseFieldGrammar cabalSpecLatest fields packageDescriptionFieldGrammar maybeWarnCabalVersion syntax pd -- Sections let gpd = emptyGpd & L.packageDescription .~ pd - -- parse sections - view stateGpd <$> execStateT - (goSections (specVersion pd) sectionFields) - (SectionS gpd Map.empty) + let specVer + | specVersion pd >= mkVersion [2,1] = CabalSpecV22 + | specVersion pd >= mkVersion [1,25] = CabalSpecV20 + | otherwise = CabalSpecOld + + view stateGpd <$> execStateT (goSections specVer sectionFields) (SectionS gpd Map.empty) where emptyGpd :: GenericPackageDescription emptyGpd = GenericPackageDescription emptyPackageDescription [] Nothing [] [] [] [] [] @@ -196,15 +200,9 @@ parseGenericPackageDescription' lexWarnings fs = do maybeWarnCabalVersion _ _ = return () - -- Sections -goSections :: Version -> [Field Position] -> SectionParser () -goSections sv = traverse_ process +goSections :: CabalSpecVersion -> [Field Position] -> SectionParser () +goSections specVer = traverse_ process where - hasElif = if sv >= mkVersion [2,1] then HasElif else NoElif - - -- Common stanzas are avaiable since cabal-version: 2.1 - hasCommonStanzas = sv >= mkVersion [2,1] - process (Field (Name pos name) _) = lift $ parseWarning pos PWTTrailingFields $ "Ignoring trailing fields after sections: " ++ show name @@ -213,15 +211,26 @@ goSections sv = traverse_ process snoc x xs = xs ++ [x] + hasCommonStanzas = specHasCommonStanzas specVer + + -- we need signature, because this is polymorphic, but not-closed + parseCondTree' + :: forall a. FromBuildInfo a + => ParsecFieldGrammar' a -- ^ grammar + -> Map String CondTreeBuildInfo -- ^ common stanzas + -> [Field Position] + -> ParseResult (CondTree ConfVar [Dependency] a) + parseCondTree' = parseCondTreeWithCommonStanzas specVer + parseSection :: Name Position -> [SectionArg Position] -> [Field Position] -> SectionParser () parseSection (Name pos name) args fields - | not hasCommonStanzas, name == "common" = lift $ do + | hasCommonStanzas == NoCommonStanzas, name == "common" = lift $ do parseWarning pos PWTUnknownSection $ "Ignoring section: common. You should set cabal-version: 2.2 or larger to use common stanzas." | name == "common" = do commonStanzas <- use stateCommonStanzas name' <- lift $ parseCommonName pos args - biTree <- lift $ parseCondTreeWithCommonStanzas hasElif hasCommonStanzas buildInfoFieldGrammar commonStanzas fields + biTree <- lift $ parseCondTree' buildInfoFieldGrammar commonStanzas fields case Map.lookup name' commonStanzas of Nothing -> stateCommonStanzas .= Map.insert name' biTree commonStanzas @@ -230,7 +239,7 @@ goSections sv = traverse_ process | name == "library" && null args = do commonStanzas <- use stateCommonStanzas - lib <- lift $ parseCondTreeWithCommonStanzas hasElif hasCommonStanzas (libraryFieldGrammar Nothing) commonStanzas fields + lib <- lift $ parseCondTree' (libraryFieldGrammar Nothing) commonStanzas fields -- TODO: check that library is defined once stateGpd . L.condLibrary ?= lib @@ -239,7 +248,7 @@ goSections sv = traverse_ process | name == "library" = do commonStanzas <- use stateCommonStanzas name' <- parseUnqualComponentName pos args - lib <- lift $ parseCondTreeWithCommonStanzas hasElif hasCommonStanzas (libraryFieldGrammar $ Just name') commonStanzas fields + lib <- lift $ parseCondTree' (libraryFieldGrammar $ Just name') commonStanzas fields -- TODO check duplicate name here? stateGpd . L.condSubLibraries %= snoc (name', lib) @@ -247,21 +256,21 @@ goSections sv = traverse_ process | name == "foreign-library" = do commonStanzas <- use stateCommonStanzas name' <- parseUnqualComponentName pos args - flib <- lift $ parseCondTreeWithCommonStanzas hasElif hasCommonStanzas (foreignLibFieldGrammar name') commonStanzas fields + flib <- lift $ parseCondTree' (foreignLibFieldGrammar name') commonStanzas fields -- TODO check duplicate name here? stateGpd . L.condForeignLibs %= snoc (name', flib) | name == "executable" = do commonStanzas <- use stateCommonStanzas name' <- parseUnqualComponentName pos args - exe <- lift $ parseCondTreeWithCommonStanzas hasElif hasCommonStanzas (executableFieldGrammar name') commonStanzas fields + exe <- lift $ parseCondTree' (executableFieldGrammar name') commonStanzas fields -- TODO check duplicate name here? stateGpd . L.condExecutables %= snoc (name', exe) | name == "test-suite" = do commonStanzas <- use stateCommonStanzas name' <- parseUnqualComponentName pos args - testStanza <- lift $ parseCondTreeWithCommonStanzas hasElif hasCommonStanzas testSuiteFieldGrammar commonStanzas fields + testStanza <- lift $ parseCondTree' testSuiteFieldGrammar commonStanzas fields testSuite <- lift $ traverse (validateTestSuite pos) testStanza -- TODO check duplicate name here? stateGpd . L.condTestSuites %= snoc (name', testSuite) @@ -269,26 +278,26 @@ goSections sv = traverse_ process | name == "benchmark" = do commonStanzas <- use stateCommonStanzas name' <- parseUnqualComponentName pos args - benchStanza <- lift $ parseCondTreeWithCommonStanzas hasElif hasCommonStanzas benchmarkFieldGrammar commonStanzas fields + benchStanza <- lift $ parseCondTree' benchmarkFieldGrammar commonStanzas fields bench <- lift $ traverse (validateBenchmark pos) benchStanza -- TODO check duplicate name here? stateGpd . L.condBenchmarks %= snoc (name', bench) | name == "flag" = do name' <- parseName pos args - name'' <- lift $ runFieldParser' pos parsec name' `recoverWith` mkFlagName "" - flag <- lift $ parseFields fields (flagFieldGrammar name'') + name'' <- lift $ runFieldParser' pos parsec specVer name' `recoverWith` mkFlagName "" + flag <- lift $ parseFields specVer fields (flagFieldGrammar name'') -- Check default flag stateGpd . L.genPackageFlags %= snoc flag | name == "custom-setup" && null args = do - sbi <- lift $ parseFields fields (setupBInfoFieldGrammar False) + sbi <- lift $ parseFields specVer fields (setupBInfoFieldGrammar False) stateGpd . L.packageDescription . L.setupBuildInfo ?= sbi | name == "source-repository" = do kind <- lift $ case args of [SecArgName spos secName] -> - runFieldParser' spos parsec (fromUTF8BS secName) `recoverWith` RepoHead + runFieldParser' spos parsec specVer (fromUTF8BS secName) `recoverWith` RepoHead [] -> do parseFailure pos "'source-repository' requires exactly one argument" pure RepoHead @@ -296,7 +305,7 @@ goSections sv = traverse_ process parseFailure pos $ "Invalid source-repository kind " ++ show args pure RepoHead - sr <- lift $ parseFields fields (sourceRepoFieldGrammar kind) + sr <- lift $ parseFields specVer fields (sourceRepoFieldGrammar kind) stateGpd . L.packageDescription . L.sourceRepos %= snoc sr | otherwise = lift $ @@ -336,33 +345,32 @@ parseUnqualComponentName pos args = mkUnqualComponentName <$> parseName pos args -- | Parse a non-recursive list of fields. parseFields - :: [Field Position] -- ^ fields to be parsed + :: CabalSpecVersion + -> [Field Position] -- ^ fields to be parsed -> ParsecFieldGrammar' a -> ParseResult a -parseFields fields grammar = do +parseFields v fields grammar = do let (fs0, ss) = partitionFields fields traverse_ (traverse_ warnInvalidSubsection) ss - parseFieldGrammar fs0 grammar + parseFieldGrammar v fs0 grammar warnInvalidSubsection :: Section Position -> ParseResult () warnInvalidSubsection (MkSection (Name pos name) _ _) = void (parseFailure pos $ "invalid subsection " ++ show name) -data HasElif = HasElif | NoElif - deriving (Eq, Show) - parseCondTree :: forall a c. - HasElif -- ^ accept @elif@ + CabalSpecVersion + -> HasElif -- ^ accept @elif@ -> ParsecFieldGrammar' a -- ^ grammar - -> (a -> c) -- ^ condition extractor + -> (a -> c) -- ^ condition extractor -> [Field Position] -> ParseResult (CondTree ConfVar c a) -parseCondTree hasElif grammar cond = go +parseCondTree v hasElif grammar cond = go where go fields = do let (fs, ss) = partitionFields fields - x <- parseFieldGrammar fs grammar + x <- parseFieldGrammar v fs grammar branches <- concat <$> traverse parseIfs ss return (CondNode x (cond x) branches) -- TODO: branches @@ -397,7 +405,7 @@ parseCondTree hasElif grammar cond = go fields' <- go fields (elseFields, sections') <- parseElseIfs sections -- we parse an empty 'Fields', to get empty value for a node - a <- parseFieldGrammar mempty grammar + a <- parseFieldGrammar v mempty grammar return (Just $ CondNode a (cond a) [CondBranch test' fields' elseFields], sections') parseElseIfs (MkSection (Name pos name) _ _ : sections) | name == "elif" = do @@ -484,22 +492,27 @@ instance FromBuildInfo BenchmarkStanza where parseCondTreeWithCommonStanzas :: forall a. FromBuildInfo a - => HasElif -- ^ accept @elif@ - -> Bool -- ^ accept @import@ - -> ParsecFieldGrammar' a -- ^ grammar + => CabalSpecVersion + -> ParsecFieldGrammar' a -- ^ grammar -> Map String CondTreeBuildInfo -- ^ common stanzas -> [Field Position] -> ParseResult (CondTree ConfVar [Dependency] a) -parseCondTreeWithCommonStanzas hasElif hasCommonStanzas grammar commonStanzas = goImports [] +parseCondTreeWithCommonStanzas v grammar commonStanzas = goImports [] where + hasElif = specHasElif v + hasCommonStanzas = specHasCommonStanzas v + + getList' :: List CommaFSep Token String -> [String] + getList' = Newtype.unpack + -- parse leading imports -- not supported: - goImports acc (Field (Name pos name) _ : fields) | name == "import", not hasCommonStanzas = do + goImports acc (Field (Name pos name) _ : fields) | name == "import", hasCommonStanzas == NoCommonStanzas = do parseWarning pos PWTUnknownField "Unknown field: import. You should set cabal-version: 2.2 or larger to use common stanzas" goImports acc fields -- supported: goImports acc (Field (Name pos name) fls : fields) | name == "import" = do - names <- runFieldParser pos (parsecCommaList parsecToken) fls + names <- getList' <$> runFieldParser pos parsec v fls names' <- for names $ \commonName -> case Map.lookup commonName commonStanzas of Nothing -> do @@ -516,7 +529,7 @@ parseCondTreeWithCommonStanzas hasElif hasCommonStanzas grammar commonStanzas = -- parse actual CondTree go :: [CondTreeBuildInfo] -> [Field Position] -> ParseResult (CondTree ConfVar [Dependency] a) go bis fields = do - x <- parseCondTree hasElif grammar (view L.targetBuildDepends) fields + x <- parseCondTree v hasElif grammar (view L.targetBuildDepends) fields pure $ foldr mergeCommonStanza x bis mergeCommonStanza @@ -599,6 +612,7 @@ sectionizeFields fs = case classifyFields fs of data Syntax = OldSyntax | NewSyntax deriving (Eq, Show) +-- TODO: libFieldNames :: [FieldName] libFieldNames = fieldGrammarKnownFieldList (libraryFieldGrammar Nothing) @@ -634,11 +648,11 @@ parseHookedBuildInfo' lexWarnings fs = do parseLib :: Fields Position -> ParseResult (Maybe BuildInfo) parseLib fields | Map.null fields = pure Nothing - | otherwise = Just <$> parseFieldGrammar fields buildInfoFieldGrammar + | otherwise = Just <$> parseFieldGrammar cabalSpecLatest fields buildInfoFieldGrammar parseExe :: (UnqualComponentName, Fields Position) -> ParseResult (UnqualComponentName, BuildInfo) parseExe (n, fields) = do - bi <- parseFieldGrammar fields buildInfoFieldGrammar + bi <- parseFieldGrammar cabalSpecLatest fields buildInfoFieldGrammar pure (n, bi) stanzas :: [Field Position] -> ParseResult (Fields Position, [(UnqualComponentName, Fields Position)]) @@ -658,7 +672,7 @@ parseHookedBuildInfo' lexWarnings fs = do :: ([FieldLine Position], [Field Position]) -> ParseResult ((UnqualComponentName, Fields Position), Maybe ([FieldLine Position], [Field Position])) toExe (fss, fields) = do - name <- runFieldParser zeroPos parsec fss + name <- runFieldParser zeroPos parsec cabalSpecLatest fss let (hdr0, rest) = breakMaybe isExecutableField fields hdr <- toFields hdr0 pure ((name, hdr), rest) diff --git a/Cabal/Distribution/Parsec/Class.hs b/Cabal/Distribution/Parsec/Class.hs index 683058c58ba..6eb1a73c518 100644 --- a/Cabal/Distribution/Parsec/Class.hs +++ b/Cabal/Distribution/Parsec/Class.hs @@ -1,11 +1,16 @@ -{-# LANGUAGE RankNTypes, FlexibleContexts #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} module Distribution.Parsec.Class ( Parsec(..), - ParsecParser, + ParsecParser (..), + runParsecParser, simpleParsec, + lexemeParsec, eitherParsec, - -- * Warnings - parsecWarning, + -- * CabalParsing & warnings + CabalParsing (..), PWarnType (..), -- * Utilities parsecToken, @@ -14,53 +19,138 @@ module Distribution.Parsec.Class ( parsecQuoted, parsecMaybeQuoted, parsecCommaList, + parsecLeadingCommaList, parsecOptCommaList, parsecStandard, parsecUnqualComponentName, ) where -import Data.Functor.Identity (Identity (..)) -import qualified Distribution.Compat.Parsec as P -import Distribution.Compat.Prelude -import Distribution.Parsec.Common (PWarnType (..), PWarning (..), Position (..)) -import Prelude () -import qualified Text.Parsec as Parsec -import qualified Text.Parsec.Language as Parsec -import qualified Text.Parsec.Token as Parsec +import Data.Char (digitToInt, intToDigit) +import Data.Functor.Identity (Identity (..)) +import Data.List (transpose) +import Distribution.CabalSpecVersion +import Distribution.Compat.Prelude +import Distribution.Parsec.Common (PWarnType (..), PWarning (..), Position (..)) +import Numeric (showIntAtBase) +import Prelude () + +import qualified Distribution.Compat.CharParsing as P +import qualified Distribution.Compat.MonadFail as Fail +import qualified Distribution.Compat.ReadP as ReadP +import qualified Text.Parsec as Parsec ------------------------------------------------------------------------------- -- Class ------------------------------------------------------------------------------- --- | --- --- TODO: implementation details: should be careful about consuming --- trailing whitespace? --- Should we always consume it? +-- | Class for parsing with @parsec@. Mainly used for @.cabal@ file fields. class Parsec a where - parsec :: ParsecParser a + 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) => CabalParsing m where + parsecWarning :: PWarnType -> String -> m () + + parsecHaskellString :: m String + parsecHaskellString = stringLiteral + + askCabalSpecVersion :: m CabalSpecVersion + +instance t ~ Char => CabalParsing (ReadP.Parser r t) where + parsecWarning _ _ = pure () + askCabalSpecVersion = pure cabalSpecLatest + +-- | 'parsec' /could/ consume trailing spaces, this function /will/ consume. +lexemeParsec :: (CabalParsing m, Parsec a) => m a +lexemeParsec = parsec <* P.spaces + +newtype ParsecParser a = PP { unPP + :: CabalSpecVersion -> Parsec.Parsec String [PWarning] a + } + +liftParsec :: Parsec.Parsec String [PWarning] a -> ParsecParser a +liftParsec p = PP $ \_ -> p + +instance Functor ParsecParser where + fmap f p = PP $ \v -> fmap f (unPP p v) + {-# INLINE fmap #-} + + x <$ p = PP $ \v -> x <$ unPP p v + {-# INLINE (<$) #-} + +instance Applicative ParsecParser where + pure = liftParsec . pure + {-# INLINE pure #-} + + f <*> x = PP $ \v -> unPP f v <*> unPP x v + {-# INLINE (<*>) #-} + f *> x = PP $ \v -> unPP f v *> unPP x v + {-# INLINE (*>) #-} + f <* x = PP $ \v -> unPP f v <* unPP x v + {-# INLINE (<*) #-} + +instance Alternative ParsecParser where + empty = liftParsec empty + + a <|> b = PP $ \v -> unPP a v <|> unPP b v + {-# INLINE (<|>) #-} + +instance Monad ParsecParser where + return = pure + + m >>= k = PP $ \v -> unPP m v >>= \x -> unPP (k x) v + {-# INLINE (>>=) #-} + (>>) = (*>) + {-# INLINE (>>) #-} + + fail = Fail.fail + +instance MonadPlus ParsecParser where + mzero = empty + mplus = (<|>) + +instance Fail.MonadFail ParsecParser where + fail = P.unexpected - -- | 'parsec' /could/ consume trailing spaces, this function /must/ consume. - lexemeParsec :: ParsecParser a - lexemeParsec = parsec <* P.spaces +instance P.Parsing ParsecParser where + try p = PP $ \v -> P.try (unPP p v) + p d = PP $ \v -> unPP p v P. d + skipMany p = PP $ \v -> P.skipMany (unPP p v) + skipSome p = PP $ \v -> P.skipSome (unPP p v) + unexpected = liftParsec . P.unexpected + eof = liftParsec P.eof + notFollowedBy p = PP $ \v -> P.notFollowedBy (unPP p v) -type ParsecParser a = forall s. P.Stream s Identity Char => P.Parsec s [PWarning] a +instance P.CharParsing ParsecParser where + satisfy = liftParsec . P.satisfy + char = liftParsec . P.char + notChar = liftParsec . P.notChar + anyChar = liftParsec P.anyChar + string = liftParsec . P.string + +instance CabalParsing ParsecParser where + parsecWarning t w = liftParsec $ Parsec.modifyState (PWarning t (Position 0 0) w :) + askCabalSpecVersion = PP pure -- | Parse a 'String' with 'lexemeParsec'. simpleParsec :: Parsec a => String -> Maybe a simpleParsec - = either (const Nothing) Just - . P.runParser (lexemeParsec <* P.eof) [] "" + = either (const Nothing) Just . runParsecParser lexemeParsec "" -- | Parse a 'String' with 'lexemeParsec'. eitherParsec :: Parsec a => String -> Either String a eitherParsec = either (Left . show) Right - . P.runParser (lexemeParsec <* P.eof) [] "" + . runParsecParser lexemeParsec "" -parsecWarning :: PWarnType -> String -> P.Parsec s [PWarning] () -parsecWarning t w = - Parsec.modifyState (PWarning t (Position 0 0) w :) +-- | Run 'ParsecParser' with 'cabalSpecLatest'. +runParsecParser :: ParsecParser a -> FilePath -> String -> Either Parsec.ParseError a +runParsecParser p n = Parsec.runParser (unPP p cabalSpecLatest <* P.eof) [] n instance Parsec a => Parsec (Identity a) where parsec = Identity <$> parsec @@ -80,21 +170,18 @@ instance Parsec Bool where "Boolean values are case sensitive, use 'True' or 'False'." -- | @[^ ,]@ -parsecToken :: P.Stream s Identity Char => P.Parsec s [PWarning] String +parsecToken :: CabalParsing m => m String parsecToken = parsecHaskellString <|> (P.munch1 (\x -> not (isSpace x) && x /= ',') P. "identifier" ) -- | @[^ ]@ -parsecToken' :: P.Stream s Identity Char => P.Parsec s [PWarning] String +parsecToken' :: CabalParsing m => m String parsecToken' = parsecHaskellString <|> (P.munch1 (not . isSpace) P. "token") -parsecFilePath :: P.Stream s Identity Char => P.Parsec s [PWarning] FilePath +parsecFilePath :: CabalParsing m => m FilePath parsecFilePath = parsecToken -- | Parse a benchmark/test-suite types. -parsecStandard - :: (Parsec ver, P.Stream s Identity Char) - => (ver -> String -> a) - -> P.Parsec s [PWarning] a +parsecStandard :: (CabalParsing m, Parsec ver) => (ver -> String -> a) -> m a parsecStandard f = do cs <- some $ P.try (component <* P.char '-') ver <- parsec @@ -107,57 +194,135 @@ parsecStandard f = do -- each component must contain an alphabetic character, to avoid -- ambiguity in identifiers like foo-1 (the 1 is the version number). -parsecCommaList - :: P.Stream s Identity Char - => P.Parsec s [PWarning] a - -> P.Parsec s [PWarning] [a] -parsecCommaList p = P.sepBy (p <* P.spaces) (P.char ',' *> P.spaces) +parsecCommaList :: CabalParsing m => m a -> m [a] +parsecCommaList p = P.sepBy (p <* P.spaces) (P.char ',' *> P.spaces P. "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 p = do + c <- P.optional comma + case c of + Nothing -> P.sepEndBy1 lp comma <|> pure [] + Just _ -> P.sepBy1 lp comma + where + lp = p <* P.spaces + comma = P.char ',' *> P.spaces P. "comma" -parsecOptCommaList - :: P.Stream s Identity Char - => P.Parsec s [PWarning] a - -> P.Parsec s [PWarning] [a] +parsecOptCommaList :: CabalParsing m => m a -> m [a] parsecOptCommaList p = P.sepBy (p <* P.spaces) (P.optional comma) where comma = P.char ',' *> P.spaces -- | Content isn't unquoted -parsecQuoted - :: P.Stream s Identity Char - => P.Parsec s [PWarning] a - -> P.Parsec s [PWarning] a +parsecQuoted :: CabalParsing m => m a -> m a parsecQuoted = P.between (P.char '"') (P.char '"') -- | @parsecMaybeQuoted p = 'parsecQuoted' p <|> p@. -parsecMaybeQuoted - :: P.Stream s Identity Char - => P.Parsec s [PWarning] a - -> P.Parsec s [PWarning] a +parsecMaybeQuoted :: CabalParsing m => m a -> m a parsecMaybeQuoted p = parsecQuoted p <|> p -parsecHaskellString :: P.Stream s Identity Char => P.Parsec s [PWarning] String -parsecHaskellString = Parsec.stringLiteral $ Parsec.makeTokenParser Parsec.emptyDef - { Parsec.commentStart = "{-" - , Parsec.commentEnd = "-}" - , Parsec.commentLine = "--" - , Parsec.nestedComments = True - , Parsec.identStart = P.satisfy isAlphaNum - , Parsec.identLetter = P.satisfy isAlphaNum <|> P.oneOf "_'" - , Parsec.opStart = opl - , Parsec.opLetter = opl - , Parsec.reservedOpNames= [] - , Parsec.reservedNames = [] - , Parsec.caseSensitive = True - } - where - opl = P.oneOf ":!#$%&*+./<=>?@\\^|-~" - -parsecUnqualComponentName :: P.Stream s Identity Char => P.Parsec s [PWarning] String +parsecUnqualComponentName :: CabalParsing m => m String parsecUnqualComponentName = intercalate "-" <$> P.sepBy1 component (P.char '-') where - component :: P.Stream s Identity Char => P.Parsec s [PWarning] String + component :: CabalParsing m => m String component = do cs <- P.munch1 isAlphaNum if all isDigit cs then fail "all digits in portion of unqualified component name" else return cs + +stringLiteral :: forall m. P.CharParsing m => m String +stringLiteral = lit where + lit :: m String + lit = foldr (maybe id (:)) "" + <$> P.between (P.char '"') (P.char '"' P. "end of string") (many stringChar) + P. "string" + + stringChar :: m (Maybe Char) + stringChar = Just <$> stringLetter + <|> stringEscape + P. "string character" + + stringLetter :: m Char + stringLetter = P.satisfy (\c -> (c /= '"') && (c /= '\\') && (c > '\026')) + + stringEscape :: m (Maybe Char) + stringEscape = P.char '\\' *> esc where + esc :: m (Maybe Char) + esc = Nothing <$ escapeGap + <|> Nothing <$ escapeEmpty + <|> Just <$> escapeCode + + escapeEmpty, escapeGap :: m Char + escapeEmpty = P.char '&' + escapeGap = P.skipSpaces1 *> (P.char '\\' P. "end of string gap") + +escapeCode :: forall m. P.CharParsing m => m Char +escapeCode = (charEsc <|> charNum <|> charAscii <|> charControl) P. "escape code" + where + charControl, charNum :: m Char + charControl = (\c -> toEnum (fromEnum c - fromEnum '@')) <$> (P.char '^' *> (P.upper <|> P.char '@')) + charNum = toEnum <$> num + where + num :: m Int + num = bounded 10 maxchar + <|> (P.char 'o' *> bounded 8 maxchar) + <|> (P.char 'x' *> bounded 16 maxchar) + maxchar = fromEnum (maxBound :: Char) + + bounded :: Int -> Int -> m Int + bounded base bnd = foldl' (\x d -> base * x + digitToInt d) 0 + <$> bounded' (take base thedigits) (map digitToInt $ showIntAtBase base intToDigit bnd "") + where + thedigits :: [m Char] + thedigits = map P.char ['0'..'9'] ++ map P.oneOf (transpose [['A'..'F'],['a'..'f']]) + + toomuch :: m a + toomuch = P.unexpected "out-of-range numeric escape sequence" + + bounded', bounded'' :: [m Char] -> [Int] -> m [Char] + bounded' dps@(zero:_) bds = P.skipSome zero *> ([] <$ P.notFollowedBy (P.choice dps) <|> bounded'' dps bds) + <|> bounded'' dps bds + bounded' [] _ = error "bounded called with base 0" + bounded'' dps [] = [] <$ P.notFollowedBy (P.choice dps) <|> toomuch + bounded'' dps (bd : bds) = let anyd :: m Char + anyd = P.choice dps + + nomore :: m () + nomore = P.notFollowedBy anyd <|> toomuch + + (low, ex : high) = splitAt bd dps + in ((:) <$> P.choice low <*> atMost (length bds) anyd) <* nomore + <|> ((:) <$> ex <*> ([] <$ nomore <|> bounded'' dps bds)) + <|> if not (null bds) + then (:) <$> P.choice high <*> atMost (length bds - 1) anyd <* nomore + else empty + atMost n p | n <= 0 = pure [] + | otherwise = ((:) <$> p <*> atMost (n - 1) p) <|> pure [] + + charEsc :: m Char + charEsc = P.choice $ parseEsc <$> escMap + + parseEsc (c,code) = code <$ P.char c + escMap = zip "abfnrtv\\\"\'" "\a\b\f\n\r\t\v\\\"\'" + + charAscii :: m Char + charAscii = P.choice $ parseAscii <$> asciiMap + + parseAscii (asc,code) = P.try $ code <$ P.string asc + asciiMap = zip (ascii3codes ++ ascii2codes) (ascii3 ++ ascii2) + ascii2codes, ascii3codes :: [String] + ascii2codes = [ "BS","HT","LF","VT","FF","CR","SO" + , "SI","EM","FS","GS","RS","US","SP"] + ascii3codes = ["NUL","SOH","STX","ETX","EOT","ENQ","ACK" + ,"BEL","DLE","DC1","DC2","DC3","DC4","NAK" + ,"SYN","ETB","CAN","SUB","ESC","DEL"] + ascii2, ascii3 :: String + ascii2 = "\BS\HT\LF\VT\FF\CR\SO\SI\EM\FS\GS\RS\US\SP" + ascii3 = "\NUL\SOH\STX\ETX\EOT\ENQ\ACK\BEL\DLE\DC1\DC2\DC3\DC4\NAK\SYN\ETB\CAN\SUB\ESC\DEL" diff --git a/Cabal/Distribution/Parsec/Common.hs b/Cabal/Distribution/Parsec/Common.hs index 972b1e18e49..d7c589430e9 100644 --- a/Cabal/Distribution/Parsec/Common.hs +++ b/Cabal/Distribution/Parsec/Common.hs @@ -6,8 +6,6 @@ module Distribution.Parsec.Common ( PWarning (..), PWarnType (..), showPWarning, - -- * Field parser - FieldParser, -- * Position Position (..), incPos, @@ -16,10 +14,9 @@ module Distribution.Parsec.Common ( zeroPos, ) where -import Prelude () -import Distribution.Compat.Prelude -import System.FilePath (normalise) -import qualified Text.Parsec as Parsec +import Distribution.Compat.Prelude +import Prelude () +import System.FilePath (normalise) -- | Parser error. data PError = PError Position String @@ -60,14 +57,6 @@ showPError :: FilePath -> PError -> String showPError fpath (PError pos msg) = normalise fpath ++ ":" ++ showPos pos ++ ": " ++ msg -------------------------------------------------------------------------------- --- Field parser -------------------------------------------------------------------------------- - --- | Field value parsers. -type FieldParser = Parsec.Parsec String [PWarning] -- :: * -> * - - ------------------------------------------------------------------------------- -- Position ------------------------------------------------------------------------------- diff --git a/Cabal/Distribution/Parsec/ConfVar.hs b/Cabal/Distribution/Parsec/ConfVar.hs index 723ecc1ef62..d7b40a0d488 100644 --- a/Cabal/Distribution/Parsec/ConfVar.hs +++ b/Cabal/Distribution/Parsec/ConfVar.hs @@ -1,22 +1,23 @@ {-# LANGUAGE OverloadedStrings #-} module Distribution.Parsec.ConfVar (parseConditionConfVar) where -import Distribution.Compat.Parsec (integral) -import Distribution.Compat.Prelude -import Distribution.Parsec.Class (Parsec (..)) -import Distribution.Parsec.Common -import Distribution.Parsec.Field (SectionArg (..)) -import Distribution.Parsec.ParseResult -import Distribution.Simple.Utils (fromUTF8BS) -import Distribution.Types.Condition -import Distribution.Types.GenericPackageDescription (ConfVar (..)) -import Distribution.Version - (anyVersion, earlierVersion, intersectVersionRanges, laterVersion, - majorBoundVersion, mkVersion, noVersion, orEarlierVersion, orLaterVersion, - thisVersion, unionVersionRanges, withinVersion) -import Prelude () -import qualified Text.Parsec as P -import qualified Text.Parsec.Error as P +import Distribution.Compat.CharParsing (char, integral) +import Distribution.Compat.Prelude +import Distribution.Parsec.Class (Parsec (..), runParsecParser) +import Distribution.Parsec.Common +import Distribution.Parsec.Field (SectionArg (..)) +import Distribution.Parsec.ParseResult +import Distribution.Simple.Utils (fromUTF8BS) +import Distribution.Types.Condition +import Distribution.Types.GenericPackageDescription (ConfVar (..)) +import Distribution.Version + (anyVersion, earlierVersion, intersectVersionRanges, laterVersion, majorBoundVersion, + mkVersion, noVersion, orEarlierVersion, orLaterVersion, thisVersion, unionVersionRanges, + withinVersion) +import Prelude () + +import qualified Text.Parsec as P +import qualified Text.Parsec.Error as P -- | Parse @'Condition' 'ConfVar'@ from section arguments provided by parsec -- based outline parser. @@ -59,7 +60,7 @@ parser = condOr version = fromParsec versionStar = mkVersion <$> fromParsec' versionStar' <* oper "*" - versionStar' = some (integral <* P.char '.') + versionStar' = some (integral <* char '.') versionRange = expr where @@ -119,7 +120,4 @@ parser = condOr fromParsec' p = do i <- ident - case P.runParser (p <* P.eof) [] "" i of - Right x -> pure x - -- TODO: better lifting or errors / warnings - Left err -> fail $ show err + either (fail . show) pure (runParsecParser p "" i) diff --git a/Cabal/Distribution/Parsec/Newtypes.hs b/Cabal/Distribution/Parsec/Newtypes.hs index b7277795dc9..b800f7b6e81 100644 --- a/Cabal/Distribution/Parsec/Newtypes.hs +++ b/Cabal/Distribution/Parsec/Newtypes.hs @@ -32,15 +32,16 @@ import Distribution.Compat.Newtype import Distribution.Compat.Prelude import Prelude () -import Data.Functor.Identity (Identity (..)) -import Data.List (dropWhileEnd) -import qualified Distribution.Compat.Parsec as P -import Distribution.Compiler (CompilerFlavor) -import Distribution.Parsec.Class -import Distribution.Parsec.Common (PWarning) -import Distribution.Pretty -import Distribution.Version (Version, VersionRange, anyVersion) -import Text.PrettyPrint (Doc, comma, fsep, punctuate, vcat, (<+>)) +import Data.Functor.Identity (Identity (..)) +import Data.List (dropWhileEnd) +import Distribution.CabalSpecVersion +import Distribution.Compiler (CompilerFlavor) +import Distribution.Parsec.Class +import Distribution.Pretty +import Distribution.Version (Version, VersionRange, anyVersion) +import Text.PrettyPrint (Doc, comma, fsep, punctuate, vcat, (<+>)) + +import qualified Distribution.Compat.CharParsing as P -- | Vertical list with commas. Displayed with 'vcat' data CommaVCat = CommaVCat @@ -62,26 +63,27 @@ data P sep = P class Sep sep where prettySep :: P sep -> [Doc] -> Doc - parseSep - :: P.Stream s Identity Char - => P sep - -> P.Parsec s [PWarning] a - -> P.Parsec s [PWarning] [a] + + parseSep :: CabalParsing m => P sep -> m a -> m [a] instance Sep CommaVCat where - prettySep _ = vcat . punctuate comma - parseSep _ = parsecCommaList + prettySep _ = vcat . punctuate comma + parseSep _ p = do + v <- askCabalSpecVersion + if v >= CabalSpecV22 then parsecLeadingCommaList p else parsecCommaList p instance Sep CommaFSep where prettySep _ = fsep . punctuate comma - parseSep _ = parsecCommaList + parseSep _ p = do + v <- askCabalSpecVersion + if v >= CabalSpecV22 then parsecLeadingCommaList p else parsecCommaList p instance Sep VCat where - prettySep _ = vcat - parseSep _ = parsecOptCommaList + prettySep _ = vcat + parseSep _ = parsecOptCommaList instance Sep FSep where - prettySep _ = fsep - parseSep _ = parsecOptCommaList + prettySep _ = fsep + parseSep _ = parsecOptCommaList instance Sep NoCommaFSep where - prettySep _ = fsep + prettySep _ = fsep parseSep _ p = many (p <* P.spaces) -- | List separated with optional commas. Displayed with @sep@, arguments of @@ -91,7 +93,7 @@ newtype List sep b a = List { getList :: [a] } -- | 'alaList' and 'alaList'' are simply 'List', with additional phantom -- arguments to constraint the resulting type -- --- >>> :t alaList VCat +-- >>> :t alaList VCat -- alaList VCat :: [a] -> List VCat (Identity a) a -- -- >>> :t alaList' FSep Token @@ -109,7 +111,7 @@ instance Newtype (List sep wrapper a) [a] where unpack = getList instance (Newtype b a, Sep sep, Parsec b) => Parsec (List sep b a) where - parsec = pack . map (unpack :: b -> a) <$> parseSep (P :: P sep) parsec + parsec = pack . map (unpack :: b -> a) <$> parseSep (P :: P sep) parsec instance (Newtype b a, Sep sep, Pretty b) => Pretty (List sep b a) where pretty = prettySep (P :: P sep) . map (pretty . (pack :: a -> b)) . unpack @@ -230,7 +232,7 @@ instance Pretty FilePathNT where -- Internal ------------------------------------------------------------------------------- -parsecTestedWith :: P.Stream s Identity Char => P.Parsec s [PWarning] (CompilerFlavor, VersionRange) +parsecTestedWith :: CabalParsing m => m (CompilerFlavor, VersionRange) parsecTestedWith = do name <- lexemeParsec ver <- parsec <|> pure anyVersion diff --git a/Cabal/Distribution/ReadE.hs b/Cabal/Distribution/ReadE.hs index fbe1b0371e3..74dcdaa878c 100644 --- a/Cabal/Distribution/ReadE.hs +++ b/Cabal/Distribution/ReadE.hs @@ -18,11 +18,11 @@ module Distribution.ReadE ( parsecToReadE, ) where -import Prelude () import Distribution.Compat.Prelude +import Prelude () import Distribution.Compat.ReadP -import qualified Distribution.Compat.Parsec as P +import Distribution.Parsec.Class -- | Parser with simple error reporting newtype ReadE a = ReadE {runReadE :: String -> Either ErrorMsg a} @@ -55,9 +55,9 @@ readP_to_E err r = of [] -> Left (err txt) (p:_) -> Right p -parsecToReadE :: (String -> ErrorMsg) -> P.Parsec String [w] a -> ReadE a +parsecToReadE :: (String -> ErrorMsg) -> ParsecParser a -> ReadE a parsecToReadE err p = ReadE $ \txt -> - case P.runParser (p <* P.spaces <* P.eof) [] "" txt of + case runParsecParser p "" txt of Right x -> Right x Left _e -> Left (err txt) -- TODO: use parsec error to make 'ErrorMsg'. diff --git a/Cabal/Distribution/SPDX.hs b/Cabal/Distribution/SPDX.hs index d8054546c0c..d30c1394421 100644 --- a/Cabal/Distribution/SPDX.hs +++ b/Cabal/Distribution/SPDX.hs @@ -39,8 +39,8 @@ import Distribution.SPDX.LicenseReference import Distribution.Utils.Generic (isAsciiAlphaNum) import Text.PrettyPrint ((<+>)) -import qualified Distribution.Compat.Parsec as P -import qualified Text.PrettyPrint as Disp +import qualified Distribution.Compat.CharParsing as P +import qualified Text.PrettyPrint as Disp -- | SPDX License Expression. -- @@ -101,9 +101,9 @@ instance Parsec LicenseExpression where simple = do n <- idstring i <- simple' n - orLater <- P.optionMaybe $ P.char '+' + orLater <- P.optional $ P.char '+' _ <- P.spaces - exc <- P.optionMaybe $ P.try (P.string "WITH" *> spaces1) *> parsec + exc <- P.optional $ P.try (P.string "WITH" *> spaces1) *> parsec return $ ELicense i (maybe Only (const OrAnyLater) orLater) exc simple' n @@ -124,12 +124,12 @@ instance Parsec LicenseExpression where compoundOr = do x <- compoundAnd - l <- P.optionMaybe $ P.try (P.string "OR" *> spaces1) *> compoundOr + l <- P.optional $ P.try (P.string "OR" *> spaces1) *> compoundOr return $ maybe id (flip EOr) l x compoundAnd = do x <- compound - l <- P.optionMaybe $ P.try (P.string "AND" *> spaces1) *> compoundAnd + l <- P.optional $ P.try (P.string "AND" *> spaces1) *> compoundAnd return $ maybe id (flip EAnd) l x compound = braces <|> simple diff --git a/Cabal/Distribution/SPDX/LicenseExceptionId.hs b/Cabal/Distribution/SPDX/LicenseExceptionId.hs index bd41a8c029f..f2433f3a3f1 100644 --- a/Cabal/Distribution/SPDX/LicenseExceptionId.hs +++ b/Cabal/Distribution/SPDX/LicenseExceptionId.hs @@ -16,7 +16,7 @@ import Distribution.Parsec.Class import Distribution.Utils.Generic (isAsciiAlphaNum) import qualified Distribution.Compat.Map.Strict as Map -import qualified Distribution.Compat.Parsec as P +import qualified Distribution.Compat.CharParsing as P import qualified Text.PrettyPrint as Disp ------------------------------------------------------------------------------- diff --git a/Cabal/Distribution/SPDX/LicenseId.hs b/Cabal/Distribution/SPDX/LicenseId.hs index 5c73b93ae7d..1479f1bfa11 100644 --- a/Cabal/Distribution/SPDX/LicenseId.hs +++ b/Cabal/Distribution/SPDX/LicenseId.hs @@ -17,7 +17,7 @@ import Distribution.Parsec.Class import Distribution.Utils.Generic (isAsciiAlphaNum) import qualified Distribution.Compat.Map.Strict as Map -import qualified Distribution.Compat.Parsec as P +import qualified Distribution.Compat.CharParsing as P import qualified Text.PrettyPrint as Disp ------------------------------------------------------------------------------- diff --git a/Cabal/Distribution/SPDX/LicenseReference.hs b/Cabal/Distribution/SPDX/LicenseReference.hs index 0a5bf84f55d..8f9d8366c0c 100644 --- a/Cabal/Distribution/SPDX/LicenseReference.hs +++ b/Cabal/Distribution/SPDX/LicenseReference.hs @@ -16,7 +16,7 @@ import Distribution.Utils.Generic (isAsciiAlphaNum) import Distribution.Pretty import Distribution.Parsec.Class -import qualified Distribution.Compat.Parsec as P +import qualified Distribution.Compat.CharParsing as P import qualified Text.PrettyPrint as Disp -- | A user defined license reference denoted by @LicenseRef-[idstring]@ (for a license not on the SPDX License List); diff --git a/Cabal/Distribution/Simple/Setup.hs b/Cabal/Distribution/Simple/Setup.hs index 4d00a15c24c..84c6cf54722 100644 --- a/Cabal/Distribution/Simple/Setup.hs +++ b/Cabal/Distribution/Simple/Setup.hs @@ -84,7 +84,7 @@ import Distribution.Text import Distribution.Parsec.Class import Distribution.Pretty import qualified Distribution.Compat.ReadP as Parse -import qualified Distribution.Compat.Parsec as P +import qualified Distribution.Compat.CharParsing as P import Distribution.ParseUtils (readPToMaybe) import qualified Text.PrettyPrint as Disp import Distribution.ModuleName diff --git a/Cabal/Distribution/System.hs b/Cabal/Distribution/System.hs index ee436262ca7..d8c3e636c7d 100644 --- a/Cabal/Distribution/System.hs +++ b/Cabal/Distribution/System.hs @@ -53,7 +53,7 @@ import Distribution.Pretty import Distribution.Text import qualified Distribution.Compat.ReadP as Parse -import qualified Distribution.Compat.Parsec as P +import qualified Distribution.Compat.CharParsing as P import qualified Text.PrettyPrint as Disp -- | How strict to be when classifying strings into the 'OS' and 'Arch' enums. @@ -271,7 +271,7 @@ ident = liftM2 (:) firstChar rest where firstChar = Parse.satisfy isAlpha rest = Parse.munch (\c -> isAlphaNum c || c == '_' || c == '-') -parsecIdent :: ParsecParser String +parsecIdent :: CabalParsing m => m String parsecIdent = (:) <$> firstChar <*> rest where firstChar = P.satisfy isAlpha diff --git a/Cabal/Distribution/Text.hs b/Cabal/Distribution/Text.hs index 7af17b07a64..92eeb79bf33 100644 --- a/Cabal/Distribution/Text.hs +++ b/Cabal/Distribution/Text.hs @@ -41,7 +41,7 @@ class Text a where parse :: Parse.ReadP r a default parse :: Parsec a => Parse.ReadP r a - parse = Parse.parsecToReadP parsec [] + parse = parsec -- | Pretty-prints with the default style. display :: Text a => a -> String diff --git a/Cabal/Distribution/Types/BuildType.hs b/Cabal/Distribution/Types/BuildType.hs index 2e3ded3f549..52e5417c6e7 100644 --- a/Cabal/Distribution/Types/BuildType.hs +++ b/Cabal/Distribution/Types/BuildType.hs @@ -13,7 +13,7 @@ import Distribution.Pretty import Distribution.Parsec.Class import Distribution.Text -import qualified Distribution.Compat.Parsec as P +import qualified Distribution.Compat.CharParsing as P import qualified Distribution.Compat.ReadP as Parse import qualified Text.PrettyPrint as Disp diff --git a/Cabal/Distribution/Types/ComponentId.hs b/Cabal/Distribution/Types/ComponentId.hs index 19b0564cda5..fd6fffc8680 100644 --- a/Cabal/Distribution/Types/ComponentId.hs +++ b/Cabal/Distribution/Types/ComponentId.hs @@ -11,7 +11,7 @@ import Distribution.Compat.Prelude import Distribution.Utils.ShortText import qualified Distribution.Compat.ReadP as Parse -import qualified Distribution.Compat.Parsec as P +import qualified Distribution.Compat.CharParsing as P import Distribution.Text import Distribution.Pretty import Distribution.Parsec.Class diff --git a/Cabal/Distribution/Types/ExeDependency.hs b/Cabal/Distribution/Types/ExeDependency.hs index e75f12a3d86..185eb256e01 100644 --- a/Cabal/Distribution/Types/ExeDependency.hs +++ b/Cabal/Distribution/Types/ExeDependency.hs @@ -16,7 +16,7 @@ import Distribution.Types.PackageName import Distribution.Types.UnqualComponentName import Distribution.Version (VersionRange, anyVersion) -import qualified Distribution.Compat.Parsec as P +import qualified Distribution.Compat.CharParsing as P import Distribution.Compat.ReadP ((<++)) import qualified Distribution.Compat.ReadP as Parse import Text.PrettyPrint (text, (<+>)) diff --git a/Cabal/Distribution/Types/ExecutableScope.hs b/Cabal/Distribution/Types/ExecutableScope.hs index 4063507b5a4..677885e26ee 100644 --- a/Cabal/Distribution/Types/ExecutableScope.hs +++ b/Cabal/Distribution/Types/ExecutableScope.hs @@ -12,7 +12,7 @@ import Distribution.Pretty import Distribution.Parsec.Class import Distribution.Text -import qualified Distribution.Compat.Parsec as P +import qualified Distribution.Compat.CharParsing as P import qualified Distribution.Compat.ReadP as Parse import qualified Text.PrettyPrint as Disp diff --git a/Cabal/Distribution/Types/ForeignLib.hs b/Cabal/Distribution/Types/ForeignLib.hs index 6787909085b..5620125d140 100644 --- a/Cabal/Distribution/Types/ForeignLib.hs +++ b/Cabal/Distribution/Types/ForeignLib.hs @@ -30,7 +30,7 @@ import Distribution.Types.ForeignLibType import Distribution.Types.UnqualComponentName import Distribution.Version -import qualified Distribution.Compat.Parsec as P +import qualified Distribution.Compat.CharParsing as P import qualified Distribution.Compat.ReadP as Parse import qualified Text.PrettyPrint as Disp import qualified Text.Read as Read diff --git a/Cabal/Distribution/Types/ForeignLibOption.hs b/Cabal/Distribution/Types/ForeignLibOption.hs index dbf61a04963..b8a4f37d6e0 100644 --- a/Cabal/Distribution/Types/ForeignLibOption.hs +++ b/Cabal/Distribution/Types/ForeignLibOption.hs @@ -12,7 +12,7 @@ import Distribution.Pretty import Distribution.Parsec.Class import Distribution.Text -import qualified Distribution.Compat.Parsec as P +import qualified Distribution.Compat.CharParsing as P import qualified Distribution.Compat.ReadP as Parse import qualified Text.PrettyPrint as Disp diff --git a/Cabal/Distribution/Types/ForeignLibType.hs b/Cabal/Distribution/Types/ForeignLibType.hs index e8ff20d3a6c..61871fc7fbd 100644 --- a/Cabal/Distribution/Types/ForeignLibType.hs +++ b/Cabal/Distribution/Types/ForeignLibType.hs @@ -15,7 +15,7 @@ import Distribution.Pretty import Distribution.Parsec.Class import Distribution.Text -import qualified Distribution.Compat.Parsec as P +import qualified Distribution.Compat.CharParsing as P import qualified Distribution.Compat.ReadP as Parse import qualified Text.PrettyPrint as Disp diff --git a/Cabal/Distribution/Types/GenericPackageDescription.hs b/Cabal/Distribution/Types/GenericPackageDescription.hs index 675a2dfdf88..3de91cd0fc6 100644 --- a/Cabal/Distribution/Types/GenericPackageDescription.hs +++ b/Cabal/Distribution/Types/GenericPackageDescription.hs @@ -31,7 +31,7 @@ import Distribution.Utils.ShortText import Distribution.Utils.Generic (lowercase) import qualified Text.PrettyPrint as Disp import qualified Distribution.Compat.ReadP as Parse -import qualified Distribution.Compat.Parsec as P +import qualified Distribution.Compat.CharParsing as P import Distribution.Compat.ReadP ((+++)) import Distribution.Types.PackageDescription @@ -238,7 +238,7 @@ parsecFlagAssignment :: ParsecParser FlagAssignment parsecFlagAssignment = FlagAssignment <$> P.sepBy (onFlag <|> offFlag) P.skipSpaces1 where onFlag = do - P.optional (P.char '+') + _ <- P.optional (P.char '+') f <- parsec return (f, True) offFlag = do diff --git a/Cabal/Distribution/Types/IncludeRenaming.hs b/Cabal/Distribution/Types/IncludeRenaming.hs index cf295b240a3..52861881faf 100644 --- a/Cabal/Distribution/Types/IncludeRenaming.hs +++ b/Cabal/Distribution/Types/IncludeRenaming.hs @@ -12,7 +12,7 @@ import Prelude () import Distribution.Types.ModuleRenaming -import qualified Distribution.Compat.Parsec as P +import qualified Distribution.Compat.CharParsing as P import Distribution.Compat.ReadP ((<++)) import qualified Distribution.Compat.ReadP as Parse import Distribution.Parsec.Class diff --git a/Cabal/Distribution/Types/LegacyExeDependency.hs b/Cabal/Distribution/Types/LegacyExeDependency.hs index 298ef7a5cfe..5fa2e5095c6 100644 --- a/Cabal/Distribution/Types/LegacyExeDependency.hs +++ b/Cabal/Distribution/Types/LegacyExeDependency.hs @@ -13,7 +13,7 @@ import Distribution.Pretty import Distribution.Text import Distribution.Version (VersionRange, anyVersion) -import qualified Distribution.Compat.Parsec as P +import qualified Distribution.Compat.CharParsing as P import Distribution.Compat.ReadP ((<++)) import qualified Distribution.Compat.ReadP as Parse import Text.PrettyPrint (text, (<+>)) diff --git a/Cabal/Distribution/Types/Mixin.hs b/Cabal/Distribution/Types/Mixin.hs index af886ec1647..d2d0c3b61d3 100644 --- a/Cabal/Distribution/Types/Mixin.hs +++ b/Cabal/Distribution/Types/Mixin.hs @@ -16,7 +16,7 @@ import Distribution.Text import Distribution.Types.IncludeRenaming import Distribution.Types.PackageName -import qualified Distribution.Compat.Parsec as P +import qualified Distribution.Compat.CharParsing as P import qualified Distribution.Compat.ReadP as Parse data Mixin = Mixin { mixinPackageName :: PackageName diff --git a/Cabal/Distribution/Types/Module.hs b/Cabal/Distribution/Types/Module.hs index fa862a128a3..eb95a5dd9d2 100644 --- a/Cabal/Distribution/Types/Module.hs +++ b/Cabal/Distribution/Types/Module.hs @@ -10,7 +10,7 @@ import Prelude () import Distribution.Compat.Prelude import qualified Distribution.Compat.ReadP as Parse -import qualified Distribution.Compat.Parsec as P +import qualified Distribution.Compat.CharParsing as P import qualified Text.PrettyPrint as Disp import Distribution.Pretty import Distribution.Parsec.Class diff --git a/Cabal/Distribution/Types/ModuleReexport.hs b/Cabal/Distribution/Types/ModuleReexport.hs index 4170bd31adf..68febc0b1a3 100644 --- a/Cabal/Distribution/Types/ModuleReexport.hs +++ b/Cabal/Distribution/Types/ModuleReexport.hs @@ -14,7 +14,7 @@ import Distribution.Pretty import Distribution.Text import Distribution.Types.PackageName -import qualified Distribution.Compat.Parsec as P +import qualified Distribution.Compat.CharParsing as P import qualified Distribution.Compat.ReadP as Parse import Text.PrettyPrint ((<+>)) import qualified Text.PrettyPrint as Disp @@ -41,7 +41,7 @@ instance Pretty ModuleReexport where instance Parsec ModuleReexport where parsec = do - mpkgname <- P.optionMaybe (P.try $ parsec <* P.char ':') + mpkgname <- P.optional (P.try $ parsec <* P.char ':') origname <- parsec newname <- P.option origname $ P.try $ do P.spaces diff --git a/Cabal/Distribution/Types/ModuleRenaming.hs b/Cabal/Distribution/Types/ModuleRenaming.hs index a4ed3cd2562..adf7887f992 100644 --- a/Cabal/Distribution/Types/ModuleRenaming.hs +++ b/Cabal/Distribution/Types/ModuleRenaming.hs @@ -18,7 +18,7 @@ import Distribution.Text import qualified Data.Map as Map import qualified Data.Set as Set -import qualified Distribution.Compat.Parsec as P +import qualified Distribution.Compat.CharParsing as P import Distribution.Compat.ReadP ((<++)) import qualified Distribution.Compat.ReadP as Parse import Text.PrettyPrint (hsep, parens, punctuate, text, (<+>), comma) diff --git a/Cabal/Distribution/Types/PkgconfigDependency.hs b/Cabal/Distribution/Types/PkgconfigDependency.hs index 204b92f5a14..e0984fa1e1c 100644 --- a/Cabal/Distribution/Types/PkgconfigDependency.hs +++ b/Cabal/Distribution/Types/PkgconfigDependency.hs @@ -15,7 +15,7 @@ import Distribution.Parsec.Class import Distribution.Pretty import Distribution.Text -import qualified Distribution.Compat.Parsec as P +import qualified Distribution.Compat.CharParsing as P import Distribution.Compat.ReadP ((<++)) import qualified Distribution.Compat.ReadP as Parse import Text.PrettyPrint ((<+>)) diff --git a/Cabal/Distribution/Types/PkgconfigName.hs b/Cabal/Distribution/Types/PkgconfigName.hs index 697a47f7089..1ad756c929c 100644 --- a/Cabal/Distribution/Types/PkgconfigName.hs +++ b/Cabal/Distribution/Types/PkgconfigName.hs @@ -13,7 +13,7 @@ import Distribution.Pretty import Distribution.Parsec.Class import Distribution.Text -import qualified Distribution.Compat.Parsec as P +import qualified Distribution.Compat.CharParsing as P import qualified Distribution.Compat.ReadP as Parse import qualified Text.PrettyPrint as Disp diff --git a/Cabal/Distribution/Types/SourceRepo.hs b/Cabal/Distribution/Types/SourceRepo.hs index 2e04db05266..28ae0efdc73 100644 --- a/Cabal/Distribution/Types/SourceRepo.hs +++ b/Cabal/Distribution/Types/SourceRepo.hs @@ -20,7 +20,7 @@ import Distribution.Pretty import Distribution.Parsec.Class import Distribution.Text -import qualified Distribution.Compat.Parsec as P +import qualified Distribution.Compat.CharParsing as P import qualified Distribution.Compat.ReadP as Parse import qualified Text.PrettyPrint as Disp diff --git a/Cabal/Distribution/Types/UnitId.hs b/Cabal/Distribution/Types/UnitId.hs index 0314911bf84..10770e75f4a 100644 --- a/Cabal/Distribution/Types/UnitId.hs +++ b/Cabal/Distribution/Types/UnitId.hs @@ -19,7 +19,7 @@ import Distribution.Compat.Prelude import Distribution.Utils.ShortText import qualified Distribution.Compat.ReadP as Parse -import qualified Distribution.Compat.Parsec as P +import qualified Distribution.Compat.CharParsing as P import Distribution.Pretty import Distribution.Parsec.Class import Distribution.Text diff --git a/Cabal/Distribution/Types/Version.hs b/Cabal/Distribution/Types/Version.hs index 5ed26757a37..56d147cb117 100644 --- a/Cabal/Distribution/Types/Version.hs +++ b/Cabal/Distribution/Types/Version.hs @@ -22,7 +22,7 @@ import Distribution.Pretty import Distribution.Text import qualified Data.Version as Base -import qualified Distribution.Compat.Parsec as P +import qualified Distribution.Compat.CharParsing as P import qualified Distribution.Compat.ReadP as Parse import qualified Text.PrettyPrint as Disp import qualified Text.Read as Read diff --git a/Cabal/Distribution/Types/VersionRange.hs b/Cabal/Distribution/Types/VersionRange.hs index 6592eec40a9..9ea8f04cd23 100644 --- a/Cabal/Distribution/Types/VersionRange.hs +++ b/Cabal/Distribution/Types/VersionRange.hs @@ -52,7 +52,7 @@ import Text.PrettyPrint ((<+>)) import qualified Text.PrettyPrint as Disp import qualified Distribution.Compat.ReadP as Parse -import qualified Distribution.Compat.Parsec as P +import qualified Distribution.Compat.CharParsing as P data VersionRange = AnyVersion diff --git a/Cabal/Language/Haskell/Extension.hs b/Cabal/Language/Haskell/Extension.hs index 4a52fe0e959..d75df568f61 100644 --- a/Cabal/Language/Haskell/Extension.hs +++ b/Cabal/Language/Haskell/Extension.hs @@ -33,7 +33,7 @@ import Distribution.Parsec.Class import Distribution.Pretty import Distribution.Text -import qualified Distribution.Compat.Parsec as P +import qualified Distribution.Compat.CharParsing as P import qualified Distribution.Compat.ReadP as Parse import qualified Text.PrettyPrint as Disp diff --git a/Cabal/changelog b/Cabal/changelog index 80013023414..278c8db6236 100644 --- a/Cabal/changelog +++ b/Cabal/changelog @@ -35,6 +35,8 @@ * Use better defaulting for `build-type`; rename `PackageDescription`'s `buildType` field to `buildTypeRaw` and introduce new `buildType` function (#4958) + * Fields with mandatory commas (e.g. build-depends) may have + leading or trailing comma (either one, not both) (#4953) * TODO 2.0.1.1 Mikhail Glushenkov December 2017 diff --git a/Cabal/tests/ParserTests.hs b/Cabal/tests/ParserTests.hs index 732b3569a97..5d6952822ca 100644 --- a/Cabal/tests/ParserTests.hs +++ b/Cabal/tests/ParserTests.hs @@ -79,10 +79,11 @@ errorTests = testGroup "errors" [ errorTest "common1.cabal" , errorTest "common2.cabal" , errorTest "common3.cabal" + , errorTest "leading-comma.cabal" ] errorTest :: FilePath -> TestTree -errorTest fp = cabalGoldenTest "errors" correct $ do +errorTest fp = cabalGoldenTest fp correct $ do contents <- BS.readFile input let res = parseGenericPackageDescription contents let (_, errs, x) = runParseResult res @@ -113,6 +114,8 @@ regressionTests = testGroup "regressions" , regressionTest "shake.cabal" , regressionTest "common.cabal" , regressionTest "common2.cabal" + , regressionTest "leading-comma.cabal" + , regressionTest "wl-pprint-indef.cabal" ] regressionTest :: FilePath -> TestTree diff --git a/Cabal/tests/ParserTests/errors/leading-comma.cabal b/Cabal/tests/ParserTests/errors/leading-comma.cabal new file mode 100644 index 00000000000..2332a115594 --- /dev/null +++ b/Cabal/tests/ParserTests/errors/leading-comma.cabal @@ -0,0 +1,20 @@ +name: leading-comma +version: 0 +synopsis: leading comma, trailing comma, or ordinary +build-type: Simple +-- too small cabal-version +cabal-version: 2.0 + +library + default-language: Haskell2010 + exposed-modules: LeadingComma + + build-depends: base, containers + + build-depends: + deepseq, + transformers, + + build-depends: + , filepath + , directory diff --git a/Cabal/tests/ParserTests/errors/leading-comma.errors b/Cabal/tests/ParserTests/errors/leading-comma.errors new file mode 100644 index 00000000000..b7597dee5b8 --- /dev/null +++ b/Cabal/tests/ParserTests/errors/leading-comma.errors @@ -0,0 +1 @@ +PError (Position 16 18) "\nunexpected end of input\nexpecting white space: \"deepseq,\\ntransformers,\"" diff --git a/Cabal/tests/ParserTests/regressions/leading-comma.cabal b/Cabal/tests/ParserTests/regressions/leading-comma.cabal new file mode 100644 index 00000000000..b9a7bdd705a --- /dev/null +++ b/Cabal/tests/ParserTests/regressions/leading-comma.cabal @@ -0,0 +1,19 @@ +name: leading-comma +version: 0 +synopsis: leading comma, trailing comma, or ordinary +build-type: Simple +cabal-version: 2.1 + +library + default-language: Haskell2010 + exposed-modules: LeadingComma + + build-depends: base, containers + + build-depends: + deepseq, + transformers, + + build-depends: + , filepath + , directory diff --git a/Cabal/tests/ParserTests/regressions/leading-comma.format b/Cabal/tests/ParserTests/regressions/leading-comma.format new file mode 100644 index 00000000000..aaae46a7418 --- /dev/null +++ b/Cabal/tests/ParserTests/regressions/leading-comma.format @@ -0,0 +1,17 @@ +name: leading-comma +version: 0 +synopsis: leading comma, trailing comma, or ordinary +cabal-version: 2.1 +build-type: Simple + +library + exposed-modules: + LeadingComma + default-language: Haskell2010 + build-depends: + base -any, + containers -any, + deepseq -any, + transformers -any, + filepath -any, + directory -any \ No newline at end of file diff --git a/Cabal/tests/ParserTests/regressions/wl-pprint-indef.cabal b/Cabal/tests/ParserTests/regressions/wl-pprint-indef.cabal new file mode 100644 index 00000000000..a58d68d2584 --- /dev/null +++ b/Cabal/tests/ParserTests/regressions/wl-pprint-indef.cabal @@ -0,0 +1,34 @@ +Name: wl-pprint-indef +Version: 1.2 +Cabal-Version: >=1.6 +Synopsis: The Wadler/Leijen Pretty Printer +Category: Text +Description: + This is a pretty printing library based on Wadler's paper "A Prettier + Printer". See the haddocks for full info. This version allows the + library user to declare overlapping instances of the 'Pretty' class. +License: BSD3 +License-file: LICENSE +Author: Daan Leijen +Maintainer: Noam Lewis +Build-Type: Simple + +Executable wl-pprint-string-example + Main-is: Main.hs + Hs-Source-Dirs: example-string + Other-Modules: StringImpl + Build-Depends: base < 5, + str-string >= 0.1.0.0, + wl-pprint-indef + Mixins: wl-pprint-indef requires (Text.PrettyPrint.Leijen.Str as StringImpl) + +Library + Exposed-Modules: Text.PrettyPrint.Leijen + Signatures: Text.PrettyPrint.Leijen.Str + Mixins: str-sig requires (Str as Text.PrettyPrint.Leijen.Str) + Build-Depends: base < 5, + str-sig >= 0.1.0.0 + +source-repository head + type: git + location: git@github.com:danidiaz/wl-pprint-indef.git diff --git a/Cabal/tests/ParserTests/regressions/wl-pprint-indef.format b/Cabal/tests/ParserTests/regressions/wl-pprint-indef.format new file mode 100644 index 00000000000..518fad6309b --- /dev/null +++ b/Cabal/tests/ParserTests/regressions/wl-pprint-indef.format @@ -0,0 +1,39 @@ +PWarning PWTUnknownField (Position 28 3) "The field \"mixins\" is available since Cabal [2,0]" +PWarning PWTUnknownField (Position 27 3) "The field \"signatures\" is available since Cabal [2,0]" +PWarning PWTUnknownField (Position 23 3) "The field \"mixins\" is available since Cabal [2,0]" +name: wl-pprint-indef +version: 1.2 +license: BSD3 +license-file: LICENSE +maintainer: Noam Lewis +author: Daan Leijen +synopsis: The Wadler/Leijen Pretty Printer +description: + This is a pretty printing library based on Wadler's paper "A Prettier + Printer". See the haddocks for full info. This version allows the + library user to declare overlapping instances of the 'Pretty' class. +category: Text +cabal-version: >=1.6 +build-type: Simple + +source-repository head + type: git + location: git@github.com:danidiaz/wl-pprint-indef.git + +library + exposed-modules: + Text.PrettyPrint.Leijen + build-depends: + base <5, + str-sig >=0.1.0.0 + +executable wl-pprint-string-example + main-is: Main.hs + scope: unknown + hs-source-dirs: example-string + other-modules: + StringImpl + build-depends: + base <5, + str-string >=0.1.0.0, + wl-pprint-indef -any \ No newline at end of file diff --git a/boot/SPDX.LicenseExceptionId.template.hs b/boot/SPDX.LicenseExceptionId.template.hs index 7bf4fc87629..dc7f8cc8f71 100644 --- a/boot/SPDX.LicenseExceptionId.template.hs +++ b/boot/SPDX.LicenseExceptionId.template.hs @@ -15,7 +15,7 @@ import Distribution.Parsec.Class import Distribution.Utils.Generic (isAsciiAlphaNum) import qualified Distribution.Compat.Map.Strict as Map -import qualified Distribution.Compat.Parsec as P +import qualified Distribution.Compat.CharParsing as P import qualified Text.PrettyPrint as Disp ------------------------------------------------------------------------------- diff --git a/boot/SPDX.LicenseId.template.hs b/boot/SPDX.LicenseId.template.hs index 3873872fad3..88532b0757b 100644 --- a/boot/SPDX.LicenseId.template.hs +++ b/boot/SPDX.LicenseId.template.hs @@ -16,7 +16,7 @@ import Distribution.Parsec.Class import Distribution.Utils.Generic (isAsciiAlphaNum) import qualified Distribution.Compat.Map.Strict as Map -import qualified Distribution.Compat.Parsec as P +import qualified Distribution.Compat.CharParsing as P import qualified Text.PrettyPrint as Disp -------------------------------------------------------------------------------