-
Notifications
You must be signed in to change notification settings - Fork 696
Commit
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
This commit reworks how GenericPackageDescription is parsed from `[Field Position]` and pretty-printed to `Doc`. This also fixes few issues: - Fix #4697: `cabal format` doesn't output custom-setup stanza (nor foreign-lib stanzas) - Fix #4719: `parse . pretty . parse = parse` for all Hackage cabal files. - `parser-hackage-tests roundtrip` is the test program. The handling of `license-file` and `license-files` is changed. Now they behave the same.
- Loading branch information
Showing
80 changed files
with
3,614 additions
and
2,019 deletions.
There are no files selected for viewing
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -0,0 +1,86 @@ | ||
| {-# LANGUAGE FlexibleContexts #-} | ||
| {-# LANGUAGE FlexibleInstances #-} | ||
| {-# LANGUAGE ScopedTypeVariables #-} | ||
| -- | This module provides a way to specify a grammar of @.cabal@ -like files. | ||
| module Distribution.FieldGrammar ( | ||
| -- * Field grammar type | ||
| FieldGrammar (..), | ||
| uniqueField, | ||
| optionalField, | ||
| optionalFieldDef, | ||
| optionalFieldDefAla, | ||
| monoidalField, | ||
| deprecatedField', | ||
| -- * Concrete grammar implementations | ||
| ParsecFieldGrammar, | ||
| ParsecFieldGrammar', | ||
| parseFieldGrammar, | ||
| fieldGrammarKnownFieldList, | ||
| PrettyFieldGrammar, | ||
| PrettyFieldGrammar', | ||
| prettyFieldGrammar, | ||
| -- * Auxlilary | ||
| (^^^), | ||
| Section(..), | ||
| Fields, | ||
| partitionFields, | ||
| takeFields, | ||
| runFieldParser, | ||
| runFieldParser', | ||
| ) where | ||
|
|
||
| import Distribution.Compat.Prelude | ||
| import Prelude () | ||
|
|
||
| import qualified Distribution.Compat.Map.Strict as Map | ||
|
|
||
| import Distribution.FieldGrammar.Class | ||
| import Distribution.FieldGrammar.Parsec | ||
| import Distribution.FieldGrammar.Pretty | ||
| import Distribution.Parsec.Field | ||
| import Distribution.Utils.Generic (spanMaybe) | ||
|
|
||
| type ParsecFieldGrammar' a = ParsecFieldGrammar a a | ||
| type PrettyFieldGrammar' a = PrettyFieldGrammar a a | ||
|
|
||
| infixl 5 ^^^ | ||
|
|
||
| -- | Reverse function application which binds tighter than '<$>' and '<*>'. | ||
| -- Useful for refining grammar specification. | ||
| -- | ||
| -- @ | ||
| -- \<*\> 'monoidalFieldAla' "extensions" (alaList' FSep MQuoted) oldExtensions | ||
| -- ^^^ 'deprecatedSince' [1,12] "Please use 'default-extensions' or 'other-extensions' fields." | ||
| -- @ | ||
| (^^^) :: a -> (a -> b) -> b | ||
| x ^^^ f = f x | ||
|
|
||
| -- | Partitionin state | ||
| data PS ann = PS (Fields ann) [Section ann] [[Section ann]] | ||
|
|
||
| -- | Partition field list into field map and groups of sections. | ||
| partitionFields :: [Field ann] -> (Fields ann, [[Section ann]]) | ||
| partitionFields = finalize . foldl' f (PS mempty mempty mempty) | ||
| where | ||
| finalize :: PS ann -> (Fields ann, [[Section ann]]) | ||
| finalize (PS fs s ss) | ||
| | null s = (fs, reverse ss) | ||
| | otherwise = (fs, reverse (reverse s : ss)) | ||
|
|
||
| f :: PS ann -> Field ann -> PS ann | ||
| f (PS fs s ss) (Field (Name ann name) fss) = | ||
| PS (Map.insertWith (flip (++)) name [MkNamelessField ann fss] fs) [] ss' | ||
| where | ||
| ss' | null s = ss | ||
| | otherwise = reverse s : ss | ||
| f (PS fs s ss) (Section name sargs sfields) = | ||
| PS fs (MkSection name sargs sfields : s) ss | ||
|
|
||
| -- | Take all fields from the front. | ||
| takeFields :: [Field ann] -> (Fields ann, [Field ann]) | ||
| takeFields = finalize . spanMaybe match | ||
| where | ||
| finalize (fs, rest) = (Map.fromListWith (flip (++)) fs, rest) | ||
|
|
||
| match (Field (Name ann name) fs) = Just (name, [MkNamelessField ann fs]) | ||
| match _ = Nothing |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -0,0 +1,149 @@ | ||
| module Distribution.FieldGrammar.Class ( | ||
| FieldGrammar (..), | ||
| uniqueField, | ||
| optionalField, | ||
| optionalFieldDef, | ||
| optionalFieldDefAla, | ||
| monoidalField, | ||
| deprecatedField', | ||
| ) where | ||
|
|
||
| import Distribution.Compat.Lens | ||
| import Distribution.Compat.Prelude | ||
| import Prelude () | ||
|
|
||
| import Data.Functor.Identity (Identity (..)) | ||
|
|
||
| import Distribution.Compat.Newtype (Newtype) | ||
| import Distribution.Parsec.Class (Parsec) | ||
| import Distribution.Parsec.Field | ||
| import Distribution.Pretty (Pretty) | ||
|
|
||
| -- | 'FieldGrammar' is parametrised by | ||
| -- | ||
| -- * @s@ which is a structure we are parsing. We need this to provide prettyprinter | ||
| -- functionality | ||
| -- | ||
| -- * @a@ type of the field. | ||
| -- | ||
| -- /Note:/ We'd like to have @forall s. Applicative (f s)@ context. | ||
| -- | ||
| class FieldGrammar g where | ||
| -- | Unfocus, zoom out, /blur/ 'FieldGrammar'. | ||
| blurFieldGrammar :: ALens' a b -> g b c -> g a c | ||
|
|
||
| -- | Field which should be defined, exactly once. | ||
| uniqueFieldAla | ||
| :: (Parsec b, Pretty b, Newtype b a) | ||
| => FieldName -- ^ field name | ||
| -> (a -> b) -- ^ 'Newtype' pack | ||
| -> ALens' s a -- ^ lens into the field | ||
| -> g s a | ||
|
|
||
| -- | Boolean field with a default value. | ||
| booleanFieldDef | ||
| :: FieldName -- ^ field name | ||
| -> ALens' s Bool -- ^ lens into the field | ||
| -> Bool -- ^ default | ||
| -> g s Bool | ||
|
|
||
| -- | Optional field. | ||
| optionalFieldAla | ||
| :: (Parsec b, Pretty b, Newtype b a) | ||
| => FieldName -- ^ field name | ||
| -> (a -> b) -- ^ 'pack' | ||
| -> ALens' s (Maybe a) -- ^ lens into the field | ||
| -> g s (Maybe a) | ||
|
|
||
| -- | Monoidal field. | ||
| -- | ||
| -- Values are combined with 'mappend'. | ||
| -- | ||
| -- /Note:/ 'optionalFieldAla' is a @monoidalField@ with 'Last' monoid. | ||
| -- | ||
| monoidalFieldAla | ||
| :: (Parsec b, Pretty b, Monoid a, Newtype b a) | ||
| => FieldName -- ^ field name | ||
| -> (a -> b) -- ^ 'pack' | ||
| -> ALens' s a -- ^ lens into the field | ||
| -> g s a | ||
|
|
||
| -- | Parser matching all fields with a name starting with a prefix. | ||
| prefixedFields | ||
| :: FieldName -- ^ field name prefix | ||
| -> ALens' s [(String, String)] -- ^ lens into the field | ||
| -> g s [(String, String)] | ||
|
|
||
| -- | Known field, which we don't parse, neither pretty print. | ||
| knownField :: FieldName -> g s () | ||
|
|
||
| -- | Field which is parsed but not pretty printed. | ||
| hiddenField :: g s a -> g s a | ||
|
|
||
| -- | Deprecated since | ||
| deprecatedSince | ||
| :: [Int] -- ^ version | ||
| -> String -- ^ deprecation message | ||
| -> g s a | ||
| -> g s a | ||
|
|
||
| -- | Annotate field with since spec-version. | ||
| availableSince | ||
| :: [Int] -- ^ spec version | ||
| -> g s a | ||
| -> g s a | ||
|
|
||
| -- | Field which can be defined at most once. | ||
| uniqueField | ||
| :: (FieldGrammar g, Parsec a, Pretty a) | ||
| => FieldName -- ^ field name | ||
| -> ALens' s a -- ^ lens into the field | ||
| -> g s a | ||
| uniqueField fn = uniqueFieldAla fn Identity | ||
|
|
||
| -- | Field which can be defined at most once. | ||
| optionalField | ||
| :: (FieldGrammar g, Parsec a, Pretty a) | ||
| => FieldName -- ^ field name | ||
| -> ALens' s (Maybe a) -- ^ lens into the field | ||
| -> g s (Maybe a) | ||
| optionalField fn = optionalFieldAla fn Identity | ||
|
|
||
| -- | Optional field with default value. | ||
| optionalFieldDef | ||
| :: (FieldGrammar g, Functor (g s), Parsec a, Pretty a, Eq a, Show a) | ||
| => FieldName -- ^ field name | ||
| -> LensLike' (Pretext (Maybe a) (Maybe a)) s a -- ^ @'Lens'' s a@: lens into the field | ||
| -> a -- ^ default value | ||
| -> g s a | ||
| optionalFieldDef fn = optionalFieldDefAla fn Identity | ||
|
|
||
| -- | Optional field with default value. | ||
| optionalFieldDefAla | ||
| :: (FieldGrammar g, Functor (g s), Parsec b, Pretty b, Newtype b a, Eq a, Show a) | ||
| => FieldName -- ^ field name | ||
| -> (a -> b) -- ^ 'Newtype' pack | ||
| -> LensLike' (Pretext (Maybe a) (Maybe a)) s a -- ^ @'Lens'' s a@: lens into the field | ||
| -> a -- ^ default value | ||
| -> g s a | ||
| optionalFieldDefAla fn pack l def = | ||
| fromMaybe def <$> optionalFieldAla fn pack (l . fromNon def) | ||
|
|
||
| -- | Field which can be define multiple times, and the results are @mappend@ed. | ||
| monoidalField | ||
| :: (FieldGrammar g, Parsec a, Pretty a, Monoid a) | ||
| => FieldName -- ^ field name | ||
| -> ALens' s a -- ^ lens into the field | ||
| -> g s a | ||
| monoidalField fn = monoidalFieldAla fn Identity | ||
|
|
||
| -- | Deprecated field. If found, warning is issued. | ||
| -- | ||
| -- /Note:/ also it's not pretty printed! | ||
| -- | ||
| deprecatedField' | ||
| :: FieldGrammar g | ||
| => String -- ^ deprecation message | ||
| -> g s a | ||
| -> g s a | ||
| deprecatedField' = deprecatedSince [] |
Oops, something went wrong.