Skip to content

Commit 72d67bf

Browse files
phadejphadej
authored
Merge pull request #6367 from haskell/ipi-short-text
Use ShortText in IPI
2 parents 386aa26 + 37d9df9 commit 72d67bf

File tree

24 files changed

+280
-186
lines changed

24 files changed

+280
-186
lines changed

‎Cabal/Distribution/FieldGrammar.hs

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -25,6 +25,7 @@ module Distribution.FieldGrammar (
2525
takeFields,
2626
runFieldParser,
2727
runFieldParser',
28+
defaultFreeTextFieldDefST,
2829
) where
2930

3031
import Distribution.Compat.Prelude

‎Cabal/Distribution/FieldGrammar/Class.hs

Lines changed: 20 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -4,6 +4,7 @@ module Distribution.FieldGrammar.Class (
44
optionalField,
55
optionalFieldDef,
66
monoidalField,
7+
defaultFreeTextFieldDefST,
78
) where
89

910
import Distribution.Compat.Lens
@@ -15,6 +16,7 @@ import Distribution.Compat.Newtype (Newtype)
1516
import Distribution.Fields.Field
1617
import Distribution.Parsec (Parsec)
1718
import Distribution.Pretty (Pretty)
19+
import Distribution.Utils.ShortText
1820

1921
-- | 'FieldGrammar' is parametrised by
2022
--
@@ -79,6 +81,12 @@ class FieldGrammar g where
7981
-> ALens' s String -- ^ lens into the field
8082
-> g s String
8183

84+
-- | @since 3.2.0.0
85+
freeTextFieldDefST
86+
:: FieldName
87+
-> ALens' s ShortText -- ^ lens into the field
88+
-> g s ShortText
89+
8290
-- | Monoidal field.
8391
--
8492
-- Values are combined with 'mappend'.
@@ -157,3 +165,15 @@ monoidalField
157165
-> ALens' s a -- ^ lens into the field
158166
-> g s a
159167
monoidalField fn = monoidalFieldAla fn Identity
168+
169+
-- | Default implementation for 'freeTextFieldDefST'.
170+
defaultFreeTextFieldDefST
171+
:: (Functor (g s), FieldGrammar g)
172+
=> FieldName
173+
-> ALens' s ShortText -- ^ lens into the field
174+
-> g s ShortText
175+
defaultFreeTextFieldDefST fn l =
176+
toShortText <$> freeTextFieldDef fn (cloneLens l . st)
177+
where
178+
st :: Lens' ShortText String
179+
st f s = toShortText <$> f (fromShortText s)

‎Cabal/Distribution/FieldGrammar/FieldDescrs.hs

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -84,6 +84,8 @@ instance FieldGrammar FieldDescrs where
8484
f s = showFreeText (aview l s)
8585
g s = cloneLens l (const parsecFreeText) s
8686

87+
freeTextFieldDefST = defaultFreeTextFieldDefST
88+
8789
monoidalFieldAla fn _pack l = singletonF fn f g where
8890
f s = pretty (pack' _pack (aview l s))
8991
g s = cloneLens l (\x -> mappend x . unpack' _pack <$> P.parsec) s

‎Cabal/Distribution/FieldGrammar/Parsec.hs

Lines changed: 24 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -71,20 +71,21 @@ import Distribution.Compat.Prelude
7171
import Distribution.Simple.Utils (fromUTF8BS)
7272
import Prelude ()
7373

74-
import qualified Data.ByteString as BS
75-
import qualified Data.List.NonEmpty as NE
76-
import qualified Data.Map.Strict as Map
77-
import qualified Data.Set as Set
78-
import qualified Text.Parsec as P
79-
import qualified Text.Parsec.Error as P
74+
import qualified Data.ByteString as BS
75+
import qualified Data.List.NonEmpty as NE
76+
import qualified Data.Map.Strict as Map
77+
import qualified Data.Set as Set
78+
import qualified Distribution.Utils.ShortText as ShortText
79+
import qualified Text.Parsec as P
80+
import qualified Text.Parsec.Error as P
8081

8182
import Distribution.CabalSpecVersion
8283
import Distribution.FieldGrammar.Class
8384
import Distribution.Fields.Field
8485
import Distribution.Fields.ParseResult
8586
import Distribution.Parsec
8687
import Distribution.Parsec.FieldLineStream
87-
import Distribution.Parsec.Position (positionRow, positionCol)
88+
import Distribution.Parsec.Position (positionCol, positionRow)
8889

8990
-------------------------------------------------------------------------------
9091
-- Auxiliary types
@@ -234,6 +235,22 @@ instance FieldGrammar ParsecFieldGrammar where
234235
| v >= CabalSpecV3_0 = pure (fieldlinesToFreeText3 pos fls)
235236
| otherwise = pure (fieldlinesToFreeText fls)
236237

238+
-- freeTextFieldDefST = defaultFreeTextFieldDefST
239+
freeTextFieldDefST fn _ = ParsecFG (Set.singleton fn) Set.empty parser where
240+
parser v fields = case Map.lookup fn fields of
241+
Nothing -> pure mempty
242+
Just [] -> pure mempty
243+
Just [x] -> parseOne v x
244+
Just xs@(_:y:ys) -> do
245+
warnMultipleSingularFields fn xs
246+
NE.last <$> traverse (parseOne v) (y:|ys)
247+
248+
parseOne v (MkNamelessField pos fls) = case fls of
249+
[] -> pure mempty
250+
[FieldLine _ bs] -> pure (ShortText.unsafeFromUTF8BS bs)
251+
_ | v >= CabalSpecV3_0 -> pure (ShortText.toShortText $ fieldlinesToFreeText3 pos fls)
252+
| otherwise -> pure (ShortText.toShortText $ fieldlinesToFreeText fls)
253+
237254
monoidalFieldAla fn _pack _extract = ParsecFG (Set.singleton fn) Set.empty parser
238255
where
239256
parser v fields = case Map.lookup fn fields of

‎Cabal/Distribution/FieldGrammar/Pretty.hs

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -72,6 +72,8 @@ instance FieldGrammar PrettyFieldGrammar where
7272
showFT | v >= CabalSpecV3_0 = showFreeTextV3
7373
| otherwise = showFreeText
7474

75+
freeTextFieldDefST = defaultFreeTextFieldDefST
76+
7577
monoidalFieldAla fn _pack l = PrettyFG pp
7678
where
7779
pp v s = ppField fn (prettyVersioned v (pack' _pack (aview l s)))

‎Cabal/Distribution/InstalledPackageInfo.hs

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -101,7 +101,7 @@ parseInstalledPackageInfo s = case P.readFields s of
101101
Left err -> Left (show err :| [])
102102
Right fs -> case partitionFields fs of
103103
(fs', _) -> case P.runParseResult $ parseFieldGrammar cabalSpecLatest fs' ipiFieldGrammar of
104-
(ws, Right x) -> ws' `deepseq` x `deepseq` Right (ws', x) where
104+
(ws, Right x) -> x `deepseq` Right (ws', x) where
105105
ws' = map (P.showPWarning "") ws
106106
(_, Left (_, errs)) -> Left errs' where
107107
errs' = fmap (P.showPError "") errs

‎Cabal/Distribution/ModuleName.hs

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -28,8 +28,8 @@ import Prelude ()
2828

2929
import Distribution.Parsec
3030
import Distribution.Pretty
31-
import Distribution.Utils.ShortText
32-
import System.FilePath (pathSeparator)
31+
import Distribution.Utils.ShortText (ShortText, fromShortText, toShortText)
32+
import System.FilePath (pathSeparator)
3333

3434
import qualified Distribution.Compat.CharParsing as P
3535
import qualified Text.PrettyPrint as Disp

‎Cabal/Distribution/PackageDescription/Check.hs

Lines changed: 9 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -73,6 +73,7 @@ import qualified System.Directory (getDirectoryContents)
7373
import qualified System.FilePath.Windows as FilePath.Windows (isValid)
7474

7575
import qualified Data.Set as Set
76+
import qualified Distribution.Utils.ShortText as ShortText
7677

7778
import qualified Distribution.Types.BuildInfo.Lens as L
7879
import qualified Distribution.Types.GenericPackageDescription.Lens as L
@@ -497,32 +498,32 @@ checkFields pkg =
497498
++ "' use '" ++ prettyShow replacement ++ "'."
498499
| (ext, Just replacement) <- ourDeprecatedExtensions ]
499500

500-
, check (null (category pkg)) $
501+
, check (ShortText.null (category pkg)) $
501502
PackageDistSuspicious "No 'category' field."
502503

503-
, check (null (maintainer pkg)) $
504+
, check (ShortText.null (maintainer pkg)) $
504505
PackageDistSuspicious "No 'maintainer' field."
505506

506-
, check (null (synopsis pkg) && null (description pkg)) $
507+
, check (ShortText.null (synopsis pkg) && ShortText.null (description pkg)) $
507508
PackageDistInexcusable "No 'synopsis' or 'description' field."
508509

509-
, check (null (description pkg) && not (null (synopsis pkg))) $
510+
, check (ShortText.null (description pkg) && not (ShortText.null (synopsis pkg))) $
510511
PackageDistSuspicious "No 'description' field."
511512

512-
, check (null (synopsis pkg) && not (null (description pkg))) $
513+
, check (ShortText.null (synopsis pkg) && not (ShortText.null (description pkg))) $
513514
PackageDistSuspicious "No 'synopsis' field."
514515

515516
--TODO: recommend the bug reports URL, author and homepage fields
516517
--TODO: recommend not using the stability field
517518
--TODO: recommend specifying a source repo
518519

519-
, check (length (synopsis pkg) >= 80) $
520+
, check (ShortText.length (synopsis pkg) >= 80) $
520521
PackageDistSuspicious
521522
"The 'synopsis' field is rather long (max 80 chars is recommended)."
522523

523524
-- See also https://github.com/haskell/cabal/pull/3479
524-
, check (not (null (description pkg))
525-
&& length (description pkg) <= length (synopsis pkg)) $
525+
, check (not (ShortText.null (description pkg))
526+
&& ShortText.length (description pkg) <= ShortText.length (synopsis pkg)) $
526527
PackageDistSuspicious $
527528
"The 'description' field should be longer than the 'synopsis' "
528529
++ "field. "

‎Cabal/Distribution/PackageDescription/FieldGrammar.hs

Lines changed: 10 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -76,18 +76,18 @@ packageDescriptionFieldGrammar = PackageDescription
7676
<*> blurFieldGrammar L.package packageIdentifierGrammar
7777
<*> optionalFieldDefAla "license" SpecLicense L.licenseRaw (Left SPDX.NONE)
7878
<*> licenseFilesGrammar
79-
<*> freeTextFieldDef "copyright" L.copyright
80-
<*> freeTextFieldDef "maintainer" L.maintainer
81-
<*> freeTextFieldDef "author" L.author
82-
<*> freeTextFieldDef "stability" L.stability
79+
<*> freeTextFieldDefST "copyright" L.copyright
80+
<*> freeTextFieldDefST "maintainer" L.maintainer
81+
<*> freeTextFieldDefST "author" L.author
82+
<*> freeTextFieldDefST "stability" L.stability
8383
<*> monoidalFieldAla "tested-with" (alaList' FSep TestedWith) L.testedWith
84-
<*> freeTextFieldDef "homepage" L.homepage
85-
<*> freeTextFieldDef "package-url" L.pkgUrl
86-
<*> freeTextFieldDef "bug-reports" L.bugReports
84+
<*> freeTextFieldDefST "homepage" L.homepage
85+
<*> freeTextFieldDefST "package-url" L.pkgUrl
86+
<*> freeTextFieldDefST "bug-reports" L.bugReports
8787
<*> pure [] -- source-repos are stanza
88-
<*> freeTextFieldDef "synopsis" L.synopsis
89-
<*> freeTextFieldDef "description" L.description
90-
<*> freeTextFieldDef "category" L.category
88+
<*> freeTextFieldDefST "synopsis" L.synopsis
89+
<*> freeTextFieldDefST "description" L.description
90+
<*> freeTextFieldDefST "category" L.category
9191
<*> prefixedFields "x-" L.customFieldsPD
9292
<*> optionalField "build-type" L.buildTypeRaw
9393
<*> pure Nothing -- custom-setup

‎Cabal/Distribution/PackageDescription/Parsec.hs

Lines changed: 3 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -36,6 +36,7 @@ import Distribution.Compat.Prelude
3636
import Prelude ()
3737

3838
import Control.Applicative (Const (..))
39+
import Control.DeepSeq (deepseq)
3940
import Control.Monad (guard)
4041
import Control.Monad.State.Strict (StateT, execStateT)
4142
import Control.Monad.Trans.Class (lift)
@@ -70,9 +71,7 @@ import Distribution.Types.PackageDescription (specVersion')
7071
import Distribution.Types.UnqualComponentName (UnqualComponentName, mkUnqualComponentName)
7172
import Distribution.Utils.Generic (breakMaybe, unfoldrM, validateUTF8)
7273
import Distribution.Verbosity (Verbosity)
73-
import Distribution.Version
74-
(LowerBound (..), Version, asVersionIntervals, mkVersion, orLaterVersion, version0,
75-
versionNumbers)
74+
import Distribution.Version (LowerBound (..), Version, asVersionIntervals, mkVersion, orLaterVersion, version0, versionNumbers)
7675

7776
import qualified Data.ByteString as BS
7877
import qualified Data.ByteString.Char8 as BS8
@@ -200,7 +199,7 @@ parseGenericPackageDescription' cabalVerM lexWarnings utf8WarnPos fs = do
200199
gpd1 <- view stateGpd <$> execStateT (goSections specVer sectionFields) (SectionS gpd Map.empty)
201200

202201
checkForUndefinedFlags gpd1
203-
return gpd1
202+
gpd1 `deepseq` return gpd1
204203
where
205204
safeLast :: [a] -> Maybe a
206205
safeLast = listToMaybe . reverse

‎Cabal/Distribution/Simple/Haddock.hs

Lines changed: 18 additions & 14 deletions
Original file line numberDiff line numberDiff line change
@@ -66,6 +66,7 @@ import Distribution.Pretty
6666
import Distribution.Parsec (simpleParsec)
6767
import Distribution.Utils.NubList
6868
import Distribution.Version
69+
import qualified Distribution.Utils.ShortText as ShortText
6970

7071
import Distribution.Verbosity
7172
import Language.Haskell.Extension
@@ -352,20 +353,23 @@ fromFlags env flags =
352353
ghcArgs = fromMaybe [] . lookup "ghc" . haddockProgramArgs $ flags
353354

354355
fromPackageDescription :: HaddockTarget -> PackageDescription -> HaddockArgs
355-
fromPackageDescription haddockTarget pkg_descr =
356-
mempty { argInterfaceFile = Flag $ haddockName pkg_descr,
357-
argPackageName = Flag $ packageId $ pkg_descr,
358-
argOutputDir = Dir $
359-
"doc" </> "html" </> haddockDirName haddockTarget pkg_descr,
360-
argPrologue = Flag $ if null desc then synopsis pkg_descr
361-
else desc,
362-
argTitle = Flag $ showPkg ++ subtitle
363-
}
364-
where
365-
desc = PD.description pkg_descr
366-
showPkg = prettyShow (packageId pkg_descr)
367-
subtitle | null (synopsis pkg_descr) = ""
368-
| otherwise = ": " ++ synopsis pkg_descr
356+
fromPackageDescription haddockTarget pkg_descr = mempty
357+
{ argInterfaceFile = Flag $ haddockName pkg_descr
358+
, argPackageName = Flag $ packageId $ pkg_descr
359+
, argOutputDir = Dir $
360+
"doc" </> "html" </> haddockDirName haddockTarget pkg_descr
361+
, argPrologue = Flag $ ShortText.fromShortText $
362+
if ShortText.null desc
363+
then synopsis pkg_descr
364+
else desc
365+
, argTitle = Flag $ showPkg ++ subtitle
366+
}
367+
where
368+
desc = PD.description pkg_descr
369+
showPkg = prettyShow (packageId pkg_descr)
370+
subtitle
371+
| ShortText.null (synopsis pkg_descr) = ""
372+
| otherwise = ": " ++ ShortText.fromShortText (synopsis pkg_descr)
369373

370374
componentGhcOptions :: Verbosity -> LocalBuildInfo
371375
-> BuildInfo -> ComponentLocalBuildInfo -> FilePath

‎Cabal/Distribution/Types/InstalledPackageInfo.hs

Lines changed: 11 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,7 @@
11
{-# LANGUAGE DeriveDataTypeable #-}
22
{-# LANGUAGE DeriveGeneric #-}
33
{-# LANGUAGE TypeFamilies #-}
4+
{-# LANGUAGE OverloadedStrings #-}
45
module Distribution.Types.InstalledPackageInfo (
56
InstalledPackageInfo (..),
67
emptyInstalledPackageInfo,
@@ -25,6 +26,7 @@ import Distribution.Types.LibraryVisibility
2526
import Distribution.Types.MungedPackageId
2627
import Distribution.Types.MungedPackageName
2728
import Distribution.Version (nullVersion)
29+
import Distribution.Utils.ShortText (ShortText)
2830

2931
import qualified Distribution.Package as Package
3032
import qualified Distribution.SPDX as SPDX
@@ -50,15 +52,15 @@ data InstalledPackageInfo
5052
instantiatedWith :: [(ModuleName, OpenModule)],
5153
compatPackageKey :: String,
5254
license :: Either SPDX.License License,
53-
copyright :: String,
54-
maintainer :: String,
55-
author :: String,
56-
stability :: String,
57-
homepage :: String,
58-
pkgUrl :: String,
59-
synopsis :: String,
60-
description :: String,
61-
category :: String,
55+
copyright :: !ShortText,
56+
maintainer :: !ShortText,
57+
author :: !ShortText,
58+
stability :: !ShortText,
59+
homepage :: !ShortText,
60+
pkgUrl :: !ShortText,
61+
synopsis :: !ShortText,
62+
description :: !ShortText,
63+
category :: !ShortText,
6264
-- these parts are required by an installed package only:
6365
abiHash :: AbiHash,
6466
indefinite :: Bool,

‎Cabal/Distribution/Types/InstalledPackageInfo/FieldGrammar.hs

Lines changed: 9 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -67,15 +67,15 @@ ipiFieldGrammar = mkInstalledPackageInfo
6767
<+> optionalFieldDefAla "instantiated-with" InstWith L.instantiatedWith []
6868
<+> optionalFieldDefAla "key" CompatPackageKey L.compatPackageKey ""
6969
<+> optionalFieldDefAla "license" SpecLicenseLenient L.license (Left SPDX.NONE)
70-
<+> freeTextFieldDef "copyright" L.copyright
71-
<+> freeTextFieldDef "maintainer" L.maintainer
72-
<+> freeTextFieldDef "author" L.author
73-
<+> freeTextFieldDef "stability" L.stability
74-
<+> freeTextFieldDef "homepage" L.homepage
75-
<+> freeTextFieldDef "package-url" L.pkgUrl
76-
<+> freeTextFieldDef "synopsis" L.synopsis
77-
<+> freeTextFieldDef "description" L.description
78-
<+> freeTextFieldDef "category" L.category
70+
<+> freeTextFieldDefST "copyright" L.copyright
71+
<+> freeTextFieldDefST "maintainer" L.maintainer
72+
<+> freeTextFieldDefST "author" L.author
73+
<+> freeTextFieldDefST "stability" L.stability
74+
<+> freeTextFieldDefST "homepage" L.homepage
75+
<+> freeTextFieldDefST "package-url" L.pkgUrl
76+
<+> freeTextFieldDefST "synopsis" L.synopsis
77+
<+> freeTextFieldDefST "description" L.description
78+
<+> freeTextFieldDefST "category" L.category
7979
-- Installed fields
8080
<+> optionalFieldDef "abi" L.abiHash (mkAbiHash "")
8181
<+> booleanFieldDef "indefinite" L.indefinite False

0 commit comments

Comments
 (0)