1
- {-# LANGUAGE DeriveFunctor #-}
2
- {-# LANGUAGE OverloadedStrings #-}
1
+ {-# LANGUAGE DeriveFunctor #-}
2
+ {-# LANGUAGE OverloadedStrings #-}
3
+ {-# LANGUAGE ScopedTypeVariables #-}
3
4
-- | This module provides a 'FieldGrammarParser', one way to parse
4
5
-- @.cabal@ -like files.
5
6
--
@@ -61,16 +62,18 @@ module Distribution.FieldGrammar.Parsec (
61
62
runFieldParser' ,
62
63
) where
63
64
65
+ import Data.List (dropWhileEnd )
66
+ import Data.Ord (comparing )
67
+ import Data.Set (Set )
68
+ import Distribution.CabalSpecVersion
69
+ import Distribution.Compat.Newtype
70
+ import Distribution.Compat.Prelude
71
+ import Distribution.Simple.Utils (fromUTF8BS )
72
+ import Prelude ()
73
+
64
74
import qualified Data.ByteString as BS
65
- import Data.List (dropWhileEnd )
66
- import Data.Ord (comparing )
67
- import Data.Set (Set )
68
75
import qualified Data.Set as Set
69
76
import qualified Distribution.Compat.Map.Strict as Map
70
- import Distribution.Compat.Prelude
71
- import Distribution.Compat.Newtype
72
- import Distribution.Simple.Utils (fromUTF8BS )
73
- import Prelude ()
74
77
import qualified Text.Parsec as P
75
78
import qualified Text.Parsec.Error as P
76
79
@@ -98,14 +101,14 @@ data Section ann = MkSection !(Name ann) [SectionArg ann] [Field ann]
98
101
-- ParsecFieldGrammar
99
102
-------------------------------------------------------------------------------
100
103
101
- data ParsecFieldGrammar s a = ParsecFG
104
+ data ParsecFieldGrammar v s a = ParsecFG
102
105
{ fieldGrammarKnownFields :: ! (Set FieldName )
103
106
, fieldGrammarKnownPrefixes :: ! (Set FieldName )
104
107
, fieldGrammarParser :: ! (Fields Position -> ParseResult a )
105
108
}
106
109
deriving (Functor )
107
110
108
- parseFieldGrammar :: Fields Position -> ParsecFieldGrammar s a -> ParseResult a
111
+ parseFieldGrammar :: Fields Position -> ParsecFieldGrammar v s a -> ParseResult a
109
112
parseFieldGrammar fields grammar = do
110
113
for_ (Map. toList (Map. filterWithKey isUnknownField fields)) $ \ (name, nfields) ->
111
114
for_ nfields $ \ (MkNamelessField pos _) ->
@@ -120,10 +123,10 @@ parseFieldGrammar fields grammar = do
120
123
k `Set.member` fieldGrammarKnownFields grammar
121
124
|| any (`BS.isPrefixOf` k) (fieldGrammarKnownPrefixes grammar)
122
125
123
- fieldGrammarKnownFieldList :: ParsecFieldGrammar s a -> [FieldName ]
126
+ fieldGrammarKnownFieldList :: ParsecFieldGrammar v s a -> [FieldName ]
124
127
fieldGrammarKnownFieldList = Set. toList . fieldGrammarKnownFields
125
128
126
- instance Applicative (ParsecFieldGrammar s ) where
129
+ instance Applicative (ParsecFieldGrammar v s ) where
127
130
pure x = ParsecFG mempty mempty (\ _ -> pure x)
128
131
{-# INLINE pure #-}
129
132
@@ -133,7 +136,7 @@ instance Applicative (ParsecFieldGrammar s) where
133
136
(\ fields -> f'' fields <*> x'' fields)
134
137
{-# INLINE (<*>) #-}
135
138
136
- instance FieldGrammar ParsecFieldGrammar where
139
+ instance CabalSpecVersion v => FieldGrammar ( ParsecFieldGrammar v ) where
137
140
blurFieldGrammar _ (ParsecFG s s' parser) = ParsecFG s s' parser
138
141
139
142
uniqueFieldAla fn _pack _extract = ParsecFG (Set. singleton fn) Set. empty parser
@@ -147,7 +150,7 @@ instance FieldGrammar ParsecFieldGrammar where
147
150
Just xs-> parseOne (last xs)
148
151
149
152
parseOne (MkNamelessField pos fls) =
150
- unpack' _pack <$> runFieldParser pos parsec fls
153
+ unpack' _pack <$> runFieldParser pos (specParsec (cabalSpecVersion :: v )) fls
151
154
152
155
booleanFieldDef fn _extract def = ParsecFG (Set. singleton fn) Set. empty parser
153
156
where
@@ -160,7 +163,7 @@ instance FieldGrammar ParsecFieldGrammar where
160
163
-- TODO: warn about duplicate optional fields?
161
164
Just xs -> parseOne (last xs)
162
165
163
- parseOne (MkNamelessField pos fls) = runFieldParser pos parsec fls
166
+ parseOne (MkNamelessField pos fls) = runFieldParser pos (specParsec (cabalSpecVersion :: v )) fls
164
167
165
168
optionalFieldAla fn _pack _extract = ParsecFG (Set. singleton fn) Set. empty parser
166
169
where
@@ -173,15 +176,15 @@ instance FieldGrammar ParsecFieldGrammar where
173
176
174
177
parseOne (MkNamelessField pos fls)
175
178
| null fls = pure Nothing
176
- | otherwise = Just . (unpack' _pack) <$> runFieldParser pos parsec fls
179
+ | otherwise = Just . (unpack' _pack) <$> runFieldParser pos (specParsec (cabalSpecVersion :: v )) fls
177
180
178
181
monoidalFieldAla fn _pack _extract = ParsecFG (Set. singleton fn) Set. empty parser
179
182
where
180
183
parser fields = case Map. lookup fn fields of
181
184
Nothing -> pure mempty
182
185
Just xs -> foldMap (unpack' _pack) <$> traverse parseOne xs
183
186
184
- parseOne (MkNamelessField pos fls) = runFieldParser pos parsec fls
187
+ parseOne (MkNamelessField pos fls) = runFieldParser pos (specParsec (cabalSpecVersion :: v )) fls
185
188
186
189
prefixedFields fnPfx _extract = ParsecFG mempty (Set. singleton fnPfx) (pure . parser)
187
190
where
@@ -199,6 +202,7 @@ instance FieldGrammar ParsecFieldGrammar where
199
202
trim :: String -> String
200
203
trim = dropWhile isSpace . dropWhileEnd isSpace
201
204
205
+ -- TODO: use versionedAvailable to drop parsing if old field.
202
206
availableSince _ = id
203
207
204
208
deprecatedSince (_ : _) _ grammar = grammar -- pass on non-empty version
0 commit comments