diff --git a/Cabal-syntax/src/Distribution/FieldGrammar.hs b/Cabal-syntax/src/Distribution/FieldGrammar.hs index c35557e2c62..a9ce4fc421a 100644 --- a/Cabal-syntax/src/Distribution/FieldGrammar.hs +++ b/Cabal-syntax/src/Distribution/FieldGrammar.hs @@ -25,7 +25,6 @@ module Distribution.FieldGrammar , takeFields , runFieldParser , runFieldParser' - , defaultFreeTextFieldDefST -- * Newtypes , module Distribution.FieldGrammar.Newtypes diff --git a/Cabal-syntax/src/Distribution/FieldGrammar/Class.hs b/Cabal-syntax/src/Distribution/FieldGrammar/Class.hs index 81daec5d3c7..d4e38b64024 100644 --- a/Cabal-syntax/src/Distribution/FieldGrammar/Class.hs +++ b/Cabal-syntax/src/Distribution/FieldGrammar/Class.hs @@ -8,11 +8,11 @@ module Distribution.FieldGrammar.Class , optionalField , optionalFieldDef , monoidalField - , defaultFreeTextFieldDefST ) where import Data.Coerce (Coercible) import Data.Kind (Constraint, Type) +import Data.Text (Text) import Distribution.Compat.Lens import Distribution.Compat.Prelude import Prelude () @@ -20,7 +20,6 @@ import Prelude () import Distribution.CabalSpecVersion (CabalSpecVersion) import Distribution.FieldGrammar.Newtypes import Distribution.Fields.Field -import Distribution.Utils.ShortText -- | @g@ is parametrised by -- @@ -91,9 +90,9 @@ class -- @since 3.0.0.0 freeTextField :: FieldName - -> ALens' s (Maybe String) + -> ALens' s (Maybe Text) -- ^ lens into the field - -> g s (Maybe String) + -> g s (Maybe Text) -- | Free text field is essentially 'optionalFieldDefAla` with @""@ -- as the default and "accept everything" parser. @@ -101,16 +100,9 @@ class -- @since 3.0.0.0 freeTextFieldDef :: FieldName - -> ALens' s String + -> ALens' s Text -- ^ lens into the field - -> g s String - - -- | @since 3.2.0.0 - freeTextFieldDefST - :: FieldName - -> ALens' s ShortText - -- ^ lens into the field - -> g s ShortText + -> g s Text -- | Monoidal field. -- @@ -130,9 +122,9 @@ class prefixedFields :: FieldName -- ^ field name prefix - -> ALens' s [(String, String)] + -> ALens' s [(Text, Text)] -- ^ lens into the field - -> g s [(String, String)] + -> g s [(Text, Text)] -- | Known field, which we don't parse, nor pretty print. knownField :: FieldName -> g s () @@ -222,16 +214,3 @@ monoidalField -- ^ lens into the field -> g s a monoidalField fn l = monoidalFieldAla fn Identity l - --- | Default implementation for 'freeTextFieldDefST'. -defaultFreeTextFieldDefST - :: FieldGrammar c g - => FieldName - -> ALens' s ShortText - -- ^ lens into the field - -> g s ShortText -defaultFreeTextFieldDefST fn l = - toShortText <$> freeTextFieldDef fn (cloneLens l . st) - where - st :: Lens' ShortText String - st f s = toShortText <$> f (fromShortText s) diff --git a/Cabal-syntax/src/Distribution/FieldGrammar/FieldDescrs.hs b/Cabal-syntax/src/Distribution/FieldGrammar/FieldDescrs.hs index 2392fa42347..1983d0f933a 100644 --- a/Cabal-syntax/src/Distribution/FieldGrammar/FieldDescrs.hs +++ b/Cabal-syntax/src/Distribution/FieldGrammar/FieldDescrs.hs @@ -17,6 +17,7 @@ import Distribution.Utils.String (trim) import Data.Coerce import qualified Data.Map as Map +import qualified Data.Text as T import qualified Distribution.Compat.CharParsing as C import qualified Distribution.Fields as P import qualified Distribution.Parsec as P @@ -107,15 +108,13 @@ instance FieldGrammar ParsecPretty FieldDescrs where freeTextField fn l = singletonF fn f g where - f s = maybe mempty showFreeText (aview l s) - g s = cloneLens l (const (Just <$> parsecFreeText)) s + f s = maybe mempty (showFreeText . T.unpack) (aview l s) + g s = cloneLens l (const (Just . T.pack <$> parsecFreeText)) s freeTextFieldDef fn l = singletonF fn f g where - f s = showFreeText (aview l s) - g s = cloneLens l (const parsecFreeText) s - - freeTextFieldDefST = defaultFreeTextFieldDefST + f s = showFreeText (T.unpack (aview l s)) + g s = cloneLens l (const (T.pack <$> parsecFreeText)) s monoidalFieldAla :: forall s proxy a b diff --git a/Cabal-syntax/src/Distribution/FieldGrammar/Parsec.hs b/Cabal-syntax/src/Distribution/FieldGrammar/Parsec.hs index fff683e80a1..dde2f604dc3 100644 --- a/Cabal-syntax/src/Distribution/FieldGrammar/Parsec.hs +++ b/Cabal-syntax/src/Distribution/FieldGrammar/Parsec.hs @@ -75,6 +75,8 @@ import Data.Coerce (Coercible, coerce) import qualified Data.List.NonEmpty as NE import qualified Data.Map.Strict as Map import qualified Data.Set as Set +import qualified Data.Text as T +import qualified Data.Text.Encoding as T import qualified Distribution.Utils.ShortText as ShortText import qualified Text.Parsec as P import qualified Text.Parsec.Error as P @@ -260,26 +262,10 @@ instance FieldGrammar Parsec ParsecFieldGrammar where parseOne v (MkNamelessField pos fls) | null fls = pure Nothing - | v >= freeTextIgnoreDotlineVers = pure (Just (fieldlinesToFreeText3 pos fls)) - | otherwise = pure (Just (fieldlinesToFreeText fls)) + | v >= freeTextIgnoreDotlineVers = pure (Just (T.pack (fieldlinesToFreeText3 pos fls))) + | otherwise = pure (Just (T.pack (fieldlinesToFreeText fls))) freeTextFieldDef fn _ = ParsecFG (Set.singleton fn) Set.empty parser - where - parser v fields = case Map.lookup fn fields of - Nothing -> pure "" - Just [] -> pure "" - Just [x] -> parseOne v x - Just xs@(_ : y : ys) -> do - warnMultipleSingularFields fn xs - NE.last <$> traverse (parseOne v) (y :| ys) - - parseOne v (MkNamelessField pos fls) - | null fls = pure "" - | v >= freeTextIgnoreDotlineVers = pure (fieldlinesToFreeText3 pos fls) - | otherwise = pure (fieldlinesToFreeText fls) - - -- freeTextFieldDefST = defaultFreeTextFieldDefST - freeTextFieldDefST fn _ = ParsecFG (Set.singleton fn) Set.empty parser where parser v fields = case Map.lookup fn fields of Nothing -> pure mempty @@ -315,12 +301,12 @@ instance FieldGrammar Parsec ParsecFieldGrammar where prefixedFields fnPfx _extract = ParsecFG mempty (Set.singleton fnPfx) (\_ fs -> pure (parser fs)) where - parser :: Fields Position -> [(String, String)] + parser :: Fields Position -> [(T.Text, T.Text)] parser values = reorder $ concatMap convert $ filter match $ Map.toList values match (fn, _) = fnPfx `BS.isPrefixOf` fn convert (fn, fields) = - [ (pos, (fromUTF8BS fn, trim $ fromUTF8BS $ fieldlinesToBS fls)) + [ (pos, (T.decodeUtf8 fn, T.strip $ T.decodeUtf8 $ fieldlinesToBS fls)) | MkNamelessField pos fls <- fields ] -- hack: recover the order of prefixed fields diff --git a/Cabal-syntax/src/Distribution/FieldGrammar/Pretty.hs b/Cabal-syntax/src/Distribution/FieldGrammar/Pretty.hs index 35f81df2711..148aaa9fa79 100644 --- a/Cabal-syntax/src/Distribution/FieldGrammar/Pretty.hs +++ b/Cabal-syntax/src/Distribution/FieldGrammar/Pretty.hs @@ -4,13 +4,14 @@ module Distribution.FieldGrammar.Pretty ) where import Data.Coerce (Coercible, coerce) +import qualified Data.Text as T +import qualified Data.Text.Encoding as T import Distribution.CabalSpecVersion import Distribution.Compat.Lens import Distribution.Compat.Prelude import Distribution.Fields.Field (FieldName) import Distribution.Fields.Pretty (PrettyField (..)) import Distribution.Pretty (Pretty (..), showFreeText, showFreeTextV3) -import Distribution.Utils.Generic (toUTF8BS) import Text.PrettyPrint (Doc) import qualified Text.PrettyPrint as PP import Prelude () @@ -84,7 +85,7 @@ instance FieldGrammar Pretty PrettyFieldGrammar where freeTextField fn l = PrettyFG pp where - pp v s = maybe mempty (ppField fn . showFT) (aview l s) + pp v s = maybe mempty (ppField fn . showFT . T.unpack) (aview l s) where showFT | v >= CabalSpecV3_0 = showFreeTextV3 @@ -93,14 +94,12 @@ instance FieldGrammar Pretty PrettyFieldGrammar where -- it's ok to just show, as showFreeText of empty string is empty. freeTextFieldDef fn l = PrettyFG pp where - pp v s = ppField fn (showFT (aview l s)) + pp v s = ppField fn (showFT (T.unpack (aview l s))) where showFT | v >= CabalSpecV3_0 = showFreeTextV3 | otherwise = showFreeText - freeTextFieldDefST = defaultFreeTextFieldDefST - monoidalFieldAla :: forall s proxy a b . (Coercible a b, Pretty b) @@ -117,7 +116,7 @@ instance FieldGrammar Pretty PrettyFieldGrammar where pp xs = -- always print the field, even its Doc is empty. -- i.e. don't use ppField - [ PrettyField () (toUTF8BS n) $ PP.vcat $ map PP.text $ lines s + [ PrettyField () (T.encodeUtf8 n) $ PP.vcat $ map (PP.text . T.unpack) $ T.lines s | (n, s) <- xs -- fnPfx `isPrefixOf` n ] diff --git a/Cabal-syntax/src/Distribution/PackageDescription/FieldGrammar.hs b/Cabal-syntax/src/Distribution/PackageDescription/FieldGrammar.hs index 05aadf7cf37..b7d3df00f76 100644 --- a/Cabal-syntax/src/Distribution/PackageDescription/FieldGrammar.hs +++ b/Cabal-syntax/src/Distribution/PackageDescription/FieldGrammar.hs @@ -82,8 +82,10 @@ import Distribution.Pretty (Pretty (..), prettyShow, showToken) import Distribution.Utils.Path import Distribution.Version (Version, VersionRange) +import Data.Bifunctor import qualified Data.ByteString.Char8 as BS8 import Data.Coerce (coerce) +import qualified Data.Text as T import qualified Distribution.Compat.CharParsing as P import qualified Distribution.SPDX as SPDX import qualified Distribution.Types.Lens as L @@ -111,19 +113,19 @@ packageDescriptionFieldGrammar = do package <- blurFieldGrammar L.package packageIdentifierGrammar licenseRaw <- optionalFieldDefAla "license" SpecLicense L.licenseRaw (Left SPDX.NONE) licenseFiles <- licenseFilesGrammar - copyright <- freeTextFieldDefST "copyright" L.copyright - maintainer <- freeTextFieldDefST "maintainer" L.maintainer - author <- freeTextFieldDefST "author" L.author - stability <- freeTextFieldDefST "stability" L.stability + copyright <- freeTextFieldDef "copyright" L.copyright + maintainer <- freeTextFieldDef "maintainer" L.maintainer + author <- freeTextFieldDef "author" L.author + stability <- freeTextFieldDef "stability" L.stability testedWith <- monoidalFieldAla "tested-with" (alaList' FSep TestedWith) L.testedWith - homepage <- freeTextFieldDefST "homepage" L.homepage - pkgUrl <- freeTextFieldDefST "package-url" L.pkgUrl - bugReports <- freeTextFieldDefST "bug-reports" L.bugReports + homepage <- freeTextFieldDef "homepage" L.homepage + pkgUrl <- freeTextFieldDef "package-url" L.pkgUrl + bugReports <- freeTextFieldDef "bug-reports" L.bugReports let sourceRepos = [] - synopsis <- freeTextFieldDefST "synopsis" L.synopsis - description <- freeTextFieldDefST "description" L.description - category <- freeTextFieldDefST "category" L.category - customFieldsPD <- prefixedFields "x-" L.customFieldsPD + synopsis <- freeTextFieldDef "synopsis" L.synopsis + description <- freeTextFieldDef "description" L.description + category <- freeTextFieldDef "category" L.category + customFieldsPD <- map (bimap T.unpack T.unpack) <$> prefixedFields "x-" L.customFieldsPDText buildTypeRaw <- optionalField "build-type" L.buildTypeRaw let setupBuildInfo = Nothing -- components @@ -712,7 +714,7 @@ buildInfoFieldGrammar = do sharedOptions <- sharedOptionsFieldGrammar profSharedOptions <- profSharedOptionsFieldGrammar let staticOptions = mempty - customFieldsBI <- prefixedFields "x-" L.customFieldsBI + customFieldsBI <- map (bimap T.unpack T.unpack) <$> prefixedFields "x-" L.customFieldsBIText targetBuildDepends <- monoidalFieldAla "build-depends" formatDependencyList L.targetBuildDepends mixins <- monoidalFieldAla "mixins" formatMixinList L.mixins @@ -807,7 +809,7 @@ flagFieldGrammar => FlagName -> g PackageFlag PackageFlag flagFieldGrammar flagName = do - flagDescription <- freeTextFieldDef "description" L.flagDescription + flagDescription <- T.unpack <$> freeTextFieldDef "description" L.flagDescription flagDefault <- booleanFieldDef "default" L.flagDefault True flagManual <- booleanFieldDef "manual" L.flagManual False pure MkPackageFlag{..} @@ -824,7 +826,7 @@ sourceRepoFieldGrammar -> g SourceRepo SourceRepo sourceRepoFieldGrammar repoKind = do repoType <- optionalField "type" L.repoType - repoLocation <- freeTextField "location" L.repoLocation + repoLocation <- fmap T.unpack <$> freeTextField "location" L.repoLocation repoModule <- optionalFieldAla "module" Token L.repoModule repoBranch <- optionalFieldAla "branch" Token L.repoBranch repoTag <- optionalFieldAla "tag" Token L.repoTag diff --git a/Cabal-syntax/src/Distribution/Types/BuildInfo/Lens.hs b/Cabal-syntax/src/Distribution/Types/BuildInfo/Lens.hs index e554f43ebdf..73f52e78040 100644 --- a/Cabal-syntax/src/Distribution/Types/BuildInfo/Lens.hs +++ b/Cabal-syntax/src/Distribution/Types/BuildInfo/Lens.hs @@ -3,9 +3,11 @@ module Distribution.Types.BuildInfo.Lens ( BuildInfo , HasBuildInfo (..) + , customFieldsBIText , HasBuildInfos (..) ) where +import Data.Bifunctor import Distribution.Compat.Lens import Distribution.Compat.Prelude import Prelude () @@ -21,6 +23,7 @@ import Distribution.Types.PkgconfigDependency (PkgconfigDependency) import Distribution.Utils.Path import Language.Haskell.Extension (Extension, Language) +import qualified Data.Text as T import qualified Distribution.Types.BuildInfo as T -- | Classy lenses for 'BuildInfo'. @@ -219,6 +222,13 @@ class HasBuildInfo a where mixins = buildInfo . mixins {-# INLINE mixins #-} +customFieldsBIText :: HasBuildInfo a => Lens' a [(T.Text, T.Text)] +customFieldsBIText = customFieldsBI . textLens + where + textLens :: Lens' [(String, String)] [(T.Text, T.Text)] + textLens f = fmap (map (bimap T.unpack T.unpack)) . f . map (bimap T.pack T.pack) +{-# INLINE customFieldsBIText #-} + instance HasBuildInfo BuildInfo where buildInfo = id {-# INLINE buildInfo #-} diff --git a/Cabal-syntax/src/Distribution/Types/GenericPackageDescription/Lens.hs b/Cabal-syntax/src/Distribution/Types/GenericPackageDescription/Lens.hs index cd04a9baeb5..7c66e918c18 100644 --- a/Cabal-syntax/src/Distribution/Types/GenericPackageDescription/Lens.hs +++ b/Cabal-syntax/src/Distribution/Types/GenericPackageDescription/Lens.hs @@ -6,6 +6,8 @@ module Distribution.Types.GenericPackageDescription.Lens , module Distribution.Types.GenericPackageDescription.Lens ) where +import Data.Text (Text) +import qualified Data.Text as T import Distribution.Compat.Lens import Distribution.Compat.Prelude import Prelude () @@ -95,8 +97,8 @@ flagName :: Lens' PackageFlag FlagName flagName f (MkPackageFlag x1 x2 x3 x4) = fmap (\y1 -> MkPackageFlag y1 x2 x3 x4) (f x1) {-# INLINE flagName #-} -flagDescription :: Lens' PackageFlag String -flagDescription f (MkPackageFlag x1 x2 x3 x4) = fmap (\y1 -> MkPackageFlag x1 y1 x3 x4) (f x2) +flagDescription :: Lens' PackageFlag Text +flagDescription f (MkPackageFlag x1 x2 x3 x4) = fmap (\y1 -> MkPackageFlag x1 (T.unpack y1) x3 x4) (f (T.pack x2)) {-# INLINE flagDescription #-} flagDefault :: Lens' PackageFlag Bool diff --git a/Cabal-syntax/src/Distribution/Types/InstalledPackageInfo/FieldGrammar.hs b/Cabal-syntax/src/Distribution/Types/InstalledPackageInfo/FieldGrammar.hs index 9d0e0513f77..51878b9f96e 100644 --- a/Cabal-syntax/src/Distribution/Types/InstalledPackageInfo/FieldGrammar.hs +++ b/Cabal-syntax/src/Distribution/Types/InstalledPackageInfo/FieldGrammar.hs @@ -83,15 +83,15 @@ ipiFieldGrammar = <@> optionalFieldDefAla "instantiated-with" InstWith L.instantiatedWith [] <@> optionalFieldDefAla "key" CompatPackageKey L.compatPackageKey "" <@> optionalFieldDefAla "license" SpecLicenseLenient L.license (Left SPDX.NONE) - <@> freeTextFieldDefST "copyright" L.copyright - <@> freeTextFieldDefST "maintainer" L.maintainer - <@> freeTextFieldDefST "author" L.author - <@> freeTextFieldDefST "stability" L.stability - <@> freeTextFieldDefST "homepage" L.homepage - <@> freeTextFieldDefST "package-url" L.pkgUrl - <@> freeTextFieldDefST "synopsis" L.synopsis - <@> freeTextFieldDefST "description" L.description - <@> freeTextFieldDefST "category" L.category + <@> freeTextFieldDef "copyright" L.copyright + <@> freeTextFieldDef "maintainer" L.maintainer + <@> freeTextFieldDef "author" L.author + <@> freeTextFieldDef "stability" L.stability + <@> freeTextFieldDef "homepage" L.homepage + <@> freeTextFieldDef "package-url" L.pkgUrl + <@> freeTextFieldDef "synopsis" L.synopsis + <@> freeTextFieldDef "description" L.description + <@> freeTextFieldDef "category" L.category -- Installed fields <@> optionalFieldDef "abi" L.abiHash (mkAbiHash "") <@> booleanFieldDef "indefinite" L.indefinite False diff --git a/Cabal-syntax/src/Distribution/Types/PackageDescription/Lens.hs b/Cabal-syntax/src/Distribution/Types/PackageDescription/Lens.hs index b04c3a45fd8..02de5bde241 100644 --- a/Cabal-syntax/src/Distribution/Types/PackageDescription/Lens.hs +++ b/Cabal-syntax/src/Distribution/Types/PackageDescription/Lens.hs @@ -5,6 +5,7 @@ module Distribution.Types.PackageDescription.Lens , module Distribution.Types.PackageDescription.Lens ) where +import Data.Bifunctor import Distribution.Compat.Lens import Distribution.Compat.Prelude import Prelude () @@ -34,6 +35,7 @@ import Distribution.Utils.Path import Distribution.Utils.ShortText (ShortText) import Distribution.Version (VersionRange) +import qualified Data.Text as T import qualified Distribution.SPDX as SPDX import qualified Distribution.Types.PackageDescription as T @@ -101,6 +103,13 @@ customFieldsPD :: Lens' PackageDescription [(String, String)] customFieldsPD f s = fmap (\x -> s{T.customFieldsPD = x}) (f (T.customFieldsPD s)) {-# INLINE customFieldsPD #-} +customFieldsPDText :: Lens' PackageDescription [(T.Text, T.Text)] +customFieldsPDText = customFieldsPD . textLens + where + textLens :: Lens' [(String, String)] [(T.Text, T.Text)] + textLens f = fmap (map (bimap T.unpack T.unpack)) . f . map (bimap T.pack T.pack) +{-# INLINE customFieldsPDText #-} + specVersion :: Lens' PackageDescription CabalSpecVersion specVersion f s = fmap (\x -> s{T.specVersion = x}) (f (T.specVersion s)) {-# INLINE specVersion #-} diff --git a/Cabal-syntax/src/Distribution/Types/SourceRepo/Lens.hs b/Cabal-syntax/src/Distribution/Types/SourceRepo/Lens.hs index 171fc6f3e97..e71c4d83e54 100644 --- a/Cabal-syntax/src/Distribution/Types/SourceRepo/Lens.hs +++ b/Cabal-syntax/src/Distribution/Types/SourceRepo/Lens.hs @@ -3,6 +3,8 @@ module Distribution.Types.SourceRepo.Lens , module Distribution.Types.SourceRepo.Lens ) where +import Data.Text (Text) +import qualified Data.Text as T import Distribution.Compat.Lens import Distribution.Compat.Prelude import Prelude () @@ -18,8 +20,8 @@ repoType :: Lens' SourceRepo (Maybe RepoType) repoType f s = fmap (\x -> s{T.repoType = x}) (f (T.repoType s)) {-# INLINE repoType #-} -repoLocation :: Lens' SourceRepo (Maybe String) -repoLocation f s = fmap (\x -> s{T.repoLocation = x}) (f (T.repoLocation s)) +repoLocation :: Lens' SourceRepo (Maybe Text) +repoLocation f s = fmap (\x -> s{T.repoLocation = fmap T.unpack x}) (f (fmap T.pack (T.repoLocation s))) {-# INLINE repoLocation #-} repoModule :: Lens' SourceRepo (Maybe String) diff --git a/buildinfo-reference-generator/src/Main.hs b/buildinfo-reference-generator/src/Main.hs index 8d7d036c528..f5358ba2edc 100644 --- a/buildinfo-reference-generator/src/Main.hs +++ b/buildinfo-reference-generator/src/Main.hs @@ -260,7 +260,6 @@ instance FieldGrammar Described Reference where freeTextField fn _l = reference fn FreeTextField freeTextFieldDef fn _l = reference fn FreeTextField - freeTextFieldDefST fn _l = reference fn FreeTextField monoidalFieldAla fn pack _l = reference fn (MonoidalFieldAla (describeDoc pack)) diff --git a/changelog.d/pr-12350.md b/changelog.d/pr-12350.md new file mode 100644 index 00000000000..73ece0a4ac7 --- /dev/null +++ b/changelog.d/pr-12350.md @@ -0,0 +1,12 @@ +--- +synopsis: Use Text instead of String in class FieldGrammar +packages: [Cabal-syntax] +prs: 12350 +--- + +Moving towards using sensible string types in Cabal, we change members +of `class FieldGrammar` to return `Text` instead of `String`. Namely, +`freeTextField`, `freeTextFieldDef` and `prefixedFields` now take a lens from `s` to `Text` +and a wrapper over `Text`. Further, `freeTextFieldDefST` is now no different +from `freeTextFieldDef` (because `type ShortText = Text`) and now is removed +together with its default implementation `defaultFreeTextFieldDefST`.