Unverified Commit e015931f authored by Oleg Grenrus's avatar Oleg Grenrus Committed by GitHub

Merge pull request #6764 from phadej/remove-text-instances

Remove text instances
parents 05bbea3e 492f7463
......@@ -38,6 +38,7 @@ module Distribution.Compat.CharParsing
, CharParsing(..)
-- * Cabal additions
, integral
, signedIntegral
, munch1
, munch
, skipSpaces1
......@@ -331,6 +332,14 @@ integral = toNumber <$> some d <?> "integral"
f _ = error "panic! integral"
{-# INLINE integral #-}
-- | Accepts negative (starting with @-@) and positive (without sign) integral
-- numbers.
--
-- @since 3.4.0.0
signedIntegral :: (CharParsing m, Integral a) => m a
signedIntegral = negate <$ char '-' <*> integral <|> integral
{-# INLINE signedIntegral #-}
-- | Greedily munch characters while predicate holds.
-- Require at least one character.
munch1 :: CharParsing m => (Char -> Bool) -> m String
......
......@@ -18,6 +18,8 @@ module Distribution.Types.Flag (
showFlagValue,
dispFlagAssignment,
parsecFlagAssignment,
parsecFlagAssignmentNonEmpty,
describeFlagAssignment,
) where
import Prelude ()
......@@ -255,3 +257,25 @@ parsecFlagAssignment = mkFlagAssignment <$>
_ <- P.char '-'
f <- parsec
return (f, False)
-- | Parse a non-empty flag assignment
--
-- The flags have to explicitly start with minus or plus.
--
-- @since 3.4.0.0
parsecFlagAssignmentNonEmpty :: CabalParsing m => m FlagAssignment
parsecFlagAssignmentNonEmpty = mkFlagAssignment . toList <$>
P.sepByNonEmpty (onFlag <|> offFlag) P.skipSpaces1
where
onFlag = do
_ <- P.char '+'
f <- parsec
return (f, True)
offFlag = do
_ <- P.char '-'
f <- parsec
return (f, False)
describeFlagAssignment :: GrammarRegex void
describeFlagAssignment = REMunch1 RESpaces1 $
REUnion [fromString "+", fromString "-"] <> describe (Proxy :: Proxy FlagName)
......@@ -49,7 +49,9 @@ import qualified Distribution.Deprecated.Text as Text
import Distribution.Deprecated.ParseUtils
( FieldDescr(..), ParseResult(..), Field(..)
, simpleField, listField, ppFields, readFields
, syntaxError, locatedErrorMsg )
, syntaxError, locatedErrorMsg, simpleFieldParsec )
import Distribution.Pretty (pretty)
import Distribution.Parsec (parsec)
import Distribution.Simple.Utils
( comparing )
......@@ -238,7 +240,7 @@ fieldDescrs =
package (\v r -> r { package = v })
, simpleField "os" Text.disp Text.parse
os (\v r -> r { os = v })
, simpleField "arch" Text.disp Text.parse
, simpleFieldParsec "arch" pretty parsec
arch (\v r -> r { arch = v })
, simpleField "compiler" Text.disp Text.parse
compiler (\v r -> r { compiler = v })
......
......@@ -15,18 +15,15 @@ module Distribution.Client.BuildReports.Types (
ReportLevel(..),
) where
import qualified Distribution.Deprecated.Text as Text
( Text(..) )
import qualified Distribution.Deprecated.ReadP as Parse
( pfail, munch1 )
import qualified Distribution.Compat.CharParsing as P
import qualified Text.PrettyPrint as Disp
( text )
import Data.Char as Char
( isAlpha, toLower )
import GHC.Generics (Generic)
import Distribution.Compat.Binary (Binary)
import Distribution.Parsec (Parsec (..))
import Distribution.Pretty (Pretty (..))
import Distribution.Utils.Structured (Structured)
data ReportLevel = NoReports | AnonymousReports | DetailedReports
......@@ -35,17 +32,19 @@ data ReportLevel = NoReports | AnonymousReports | DetailedReports
instance Binary ReportLevel
instance Structured ReportLevel
instance Text.Text ReportLevel where
disp NoReports = Disp.text "none"
disp AnonymousReports = Disp.text "anonymous"
disp DetailedReports = Disp.text "detailed"
parse = do
name <- Parse.munch1 Char.isAlpha
instance Pretty ReportLevel where
pretty NoReports = Disp.text "none"
pretty AnonymousReports = Disp.text "anonymous"
pretty DetailedReports = Disp.text "detailed"
instance Parsec ReportLevel where
parsec = do
name <- P.munch1 Char.isAlpha
case lowercase name of
"none" -> return NoReports
"anonymous" -> return AnonymousReports
"detailed" -> return DetailedReports
_ -> Parse.pfail
_ -> P.unexpected $ "ReportLevel: " ++ name
lowercase :: String -> String
lowercase = map Char.toLower
......@@ -94,7 +94,9 @@ import Distribution.Deprecated.ParseUtils
, locatedErrorMsg, showPWarning
, readFields, warning, lineNo
, simpleField, listField, spaceListField
, parseFilePathQ, parseOptCommaList, parseTokenQ, syntaxError)
, parseFilePathQ, parseOptCommaList, parseTokenQ, syntaxError
, simpleFieldParsec
)
import Distribution.Client.ParseUtils
( parseFields, ppFields, ppSection )
import Distribution.Client.HttpUtils
......@@ -115,6 +117,7 @@ import Distribution.Compiler
( CompilerFlavor(..), defaultCompilerFlavor )
import Distribution.Verbosity
( Verbosity, normal )
import qualified Distribution.Compat.CharParsing as P
import Distribution.Solver.Types.ConstraintSource
......@@ -1345,8 +1348,8 @@ remoteRepoFields =
, listField "root-keys"
text parseTokenQ
remoteRepoRootKeys (\x repo -> repo { remoteRepoRootKeys = x })
, simpleField "key-threshold"
showThreshold Text.parse
, simpleFieldParsec "key-threshold"
showThreshold P.integral
remoteRepoKeyThreshold (\x repo -> repo { remoteRepoKeyThreshold = x })
]
where
......
......@@ -26,6 +26,7 @@ import Prelude ()
import Distribution.Client.Compat.Prelude
import Distribution.Utils.Generic (safeHead)
import Distribution.Pretty (prettyShow)
import Distribution.Client.Dependency
import qualified Distribution.Client.InstallPlan as InstallPlan
import Distribution.Client.SolverInstallPlan (SolverInstallPlan)
......@@ -287,7 +288,7 @@ checkConfigExFlags verbosity installedPkgIndex sourcePkgIndex flags = do
unknown pkg = null (lookupPackageName installedPkgIndex pkg)
&& not (elemByPackageName sourcePkgIndex pkg)
showConstraint (uc, src) =
display uc ++ " (" ++ showConstraintSource src ++ ")"
prettyShow uc ++ " (" ++ showConstraintSource src ++ ")"
-- | Make an 'InstallPlan' for the unpacked package in the current directory,
-- and all its dependencies.
......
......@@ -8,10 +8,11 @@ module Distribution.Client.Dependency.Types (
import Distribution.Client.Compat.Prelude
import Prelude ()
import Distribution.Deprecated.Text (Text (..))
import Text.PrettyPrint (text)
import Distribution.Parsec (Parsec (..))
import Distribution.Pretty (Pretty (..))
import Text.PrettyPrint (text)
import qualified Distribution.Deprecated.ReadP as Parse (munch1, pfail)
import qualified Distribution.Compat.CharParsing as P
-- | All the solvers that can be selected.
......@@ -28,13 +29,15 @@ instance Binary Solver
instance Structured PreSolver
instance Structured Solver
instance Text PreSolver where
disp AlwaysModular = text "modular"
parse = do
name <- Parse.munch1 isAlpha
case map toLower name of
"modular" -> return AlwaysModular
_ -> Parse.pfail
instance Pretty PreSolver where
pretty AlwaysModular = text "modular"
instance Parsec PreSolver where
parsec = do
name <- P.munch1 isAlpha
case map toLower name of
"modular" -> return AlwaysModular
_ -> P.unexpected $ "PreSolver: " ++ name
-- | Global policy for all packages to say if we prefer package versions that
-- are already installed locally or if we just prefer the latest available.
......
......@@ -36,7 +36,6 @@ import Distribution.Simple.Utils
import Distribution.Verbosity
( Verbosity )
import Distribution.Pretty (prettyShow)
import Distribution.Deprecated.Text (display)
import qualified Distribution.PackageDescription as PD
import Distribution.Simple.Program
( programName )
......@@ -171,7 +170,7 @@ unpackPackage :: Verbosity -> FilePath -> PackageId
-> PackageDescriptionOverride
-> FilePath -> IO ()
unpackPackage verbosity prefix pkgid descOverride pkgPath = do
let pkgdirname = display pkgid
let pkgdirname = prettyShow pkgid
pkgdir = prefix </> pkgdirname
pkgdir' = addTrailingPathSeparator pkgdir
emptyDirectory directory = null <$> listDirectory directory
......@@ -190,7 +189,7 @@ unpackPackage verbosity prefix pkgid descOverride pkgPath = do
case descOverride of
Nothing -> return ()
Just pkgtxt -> do
let descFilePath = pkgdir </> display (packageName pkgid) <.> "cabal"
let descFilePath = pkgdir </> prettyShow (packageName pkgid) <.> "cabal"
info verbosity $
"Updating " ++ descFilePath
++ " with the latest revision from the index."
......@@ -214,37 +213,37 @@ data ClonePackageException =
instance Exception ClonePackageException where
displayException (ClonePackageNoSourceRepos pkgid) =
"Cannot fetch a source repository for package " ++ display pkgid
"Cannot fetch a source repository for package " ++ prettyShow pkgid
++ ". The package does not specify any source repositories."
displayException (ClonePackageNoSourceReposOfKind pkgid repoKind) =
"Cannot fetch a source repository for package " ++ display pkgid
"Cannot fetch a source repository for package " ++ prettyShow pkgid
++ ". The package does not specify a source repository of the requested "
++ "kind" ++ maybe "." (\k -> " (kind " ++ display k ++ ").") repoKind
++ "kind" ++ maybe "." (\k -> " (kind " ++ prettyShow k ++ ").") repoKind
displayException (ClonePackageNoRepoType pkgid _repo) =
"Cannot fetch the source repository for package " ++ display pkgid
"Cannot fetch the source repository for package " ++ prettyShow pkgid
++ ". The package's description specifies a source repository but does "
++ "not specify the repository 'type' field (e.g. git, darcs or hg)."
displayException (ClonePackageUnsupportedRepoType pkgid _ repoType) =
"Cannot fetch the source repository for package " ++ display pkgid
++ ". The repository type '" ++ display repoType
"Cannot fetch the source repository for package " ++ prettyShow pkgid
++ ". The repository type '" ++ prettyShow repoType
++ "' is not yet supported."
displayException (ClonePackageNoRepoLocation pkgid _repo) =
"Cannot fetch the source repository for package " ++ display pkgid
"Cannot fetch the source repository for package " ++ prettyShow pkgid
++ ". The package's description specifies a source repository but does "
++ "not specify the repository 'location' field (i.e. the URL)."
displayException (ClonePackageDestinationExists pkgid dest isdir) =
"Not fetching the source repository for package " ++ display pkgid ++ ". "
"Not fetching the source repository for package " ++ prettyShow pkgid ++ ". "
++ if isdir then "The destination directory " ++ dest ++ " already exists."
else "A file " ++ dest ++ " is in the way."
displayException (ClonePackageFailedWithExitCode
pkgid repo vcsprogname exitcode) =
"Failed to fetch the source repository for package " ++ display pkgid
"Failed to fetch the source repository for package " ++ prettyShow pkgid
++ ", repository location " ++ srpLocation repo ++ " ("
++ vcsprogname ++ " failed with " ++ show exitcode ++ ")."
......@@ -302,7 +301,7 @@ clonePackagesFromSourceRepo verbosity destDirPrefix
Left SourceRepoLocationUnspecified ->
throwIO (ClonePackageNoRepoLocation pkgid repo)
let destDir = destDirPrefix </> display (packageName pkgid)
let destDir = destDirPrefix </> prettyShow (packageName pkgid)
destDirExists <- doesDirectoryExist destDir
destFileExists <- doesFileExist destDir
when (destDirExists || destFileExists) $
......
......@@ -40,6 +40,8 @@ import Distribution.Client.CmdInstall.ClientInstallFlags
import Distribution.Solver.Types.ConstraintSource
import Distribution.Pretty (Pretty (..))
import Distribution.Parsec (Parsec (..))
import Distribution.Package
import Distribution.PackageDescription
( dispFlagAssignment )
......@@ -79,7 +81,7 @@ import Text.PrettyPrint
import qualified Distribution.Deprecated.ParseUtils as ParseUtils
import Distribution.Deprecated.ParseUtils
( ParseResult(..), PError(..), syntaxError, PWarning(..)
, simpleField, commaNewLineListField, newLineListField, parseTokenQ
, simpleField, commaNewLineListFieldParsec, newLineListField, parseTokenQ
, parseHaskellString, showToken )
import Distribution.Client.ParseUtils
import Distribution.Simple.Command
......@@ -87,8 +89,7 @@ import Distribution.Simple.Command
, OptionField, option, reqArg' )
import Distribution.Types.PackageVersionConstraint
( PackageVersionConstraint )
import Distribution.Parsec (Parsec (..), ParsecParser)
import Distribution.Pretty (Pretty (..))
import Distribution.Parsec (ParsecParser)
import qualified Data.Map as Map
......@@ -860,8 +861,8 @@ legacyProjectConfigFieldDescrs =
(Disp.text . renderPackageLocationToken) parsePackageLocationTokenQ
legacyPackagesOptional
(\v flags -> flags { legacyPackagesOptional = v })
, commaNewLineListField "extra-packages"
disp parse
, commaNewLineListFieldParsec "extra-packages"
pretty parsec
legacyPackagesNamed
(\v flags -> flags { legacyPackagesNamed = v })
]
......@@ -959,12 +960,12 @@ legacySharedConfigFieldDescrs =
legacyConfigureExFlags
(\flags conf -> conf { legacyConfigureExFlags = flags })
. addFields
[ commaNewLineListField "constraints"
(disp . fst) (fmap (\constraint -> (constraint, constraintSrc)) parse)
[ commaNewLineListFieldParsec "constraints"
(pretty . fst) (fmap (\constraint -> (constraint, constraintSrc)) parsec)
configExConstraints (\v conf -> conf { configExConstraints = v })
, commaNewLineListField "preferences"
disp parse
, commaNewLineListFieldParsec "preferences"
pretty parsec
configPreferences (\v conf -> conf { configPreferences = v })
, monoidFieldParsec "allow-older"
......@@ -1014,7 +1015,7 @@ legacySharedConfigFieldDescrs =
. commandOptionsToFields
) (clientInstallOptions ParseArgs)
where
constraintSrc = ConstraintSourceProjectConfig "TODO"
constraintSrc = ConstraintSourceProjectConfig "TODO" -- TODO: is a filepath
legacyPackageConfigFieldDescrs :: [FieldDescr LegacyPackageConfig]
......
......@@ -44,7 +44,7 @@ import Distribution.Simple.GHC
( getImplInfo, GhcImplInfo(supportsPkgEnvFiles)
, GhcEnvironmentFileEntry(..), simpleGhcEnvironmentFile
, writeGhcEnvironmentFile )
import Distribution.Deprecated.Text
import Distribution.Pretty (Pretty, prettyShow)
import qualified Distribution.Compat.Graph as Graph
import Distribution.Compat.Graph (Graph, Node)
import qualified Distribution.Compat.Binary as Binary
......@@ -236,19 +236,19 @@ encodePlanAsJson distDirLayout elaboratedInstallPlan elaboratedSharedConfig =
["bin-file" J..= J.String bin]
where
bin = if elabBuildStyle elab == BuildInplaceOnly
then dist_dir </> "build" </> display s </> display s
else InstallDirs.bindir (elabInstallDirs elab) </> display s
then dist_dir </> "build" </> prettyShow s </> prettyShow s
else InstallDirs.bindir (elabInstallDirs elab) </> prettyShow s
-- TODO: maybe move this helper to "ComponentDeps" module?
-- Or maybe define a 'Text' instance?
comp2str :: ComponentDeps.Component -> String
comp2str c = case c of
ComponentDeps.ComponentLib -> "lib"
ComponentDeps.ComponentSubLib s -> "lib:" <> display s
ComponentDeps.ComponentFLib s -> "flib:" <> display s
ComponentDeps.ComponentExe s -> "exe:" <> display s
ComponentDeps.ComponentTest s -> "test:" <> display s
ComponentDeps.ComponentBench s -> "bench:" <> display s
ComponentDeps.ComponentSubLib s -> "lib:" <> prettyShow s
ComponentDeps.ComponentFLib s -> "flib:" <> prettyShow s
ComponentDeps.ComponentExe s -> "exe:" <> prettyShow s
ComponentDeps.ComponentTest s -> "test:" <> prettyShow s
ComponentDeps.ComponentBench s -> "bench:" <> prettyShow s
ComponentDeps.ComponentSetup -> "setup"
style2str :: Bool -> BuildStyle -> String
......@@ -256,8 +256,8 @@ encodePlanAsJson distDirLayout elaboratedInstallPlan elaboratedSharedConfig =
style2str False BuildInplaceOnly = "inplace"
style2str False BuildAndInstall = "global"
jdisplay :: Text a => a -> J.Value
jdisplay = J.String . display
jdisplay :: Pretty a => a -> J.Value
jdisplay = J.String . prettyShow
-----------------------------------------------------------------------------
......@@ -692,7 +692,7 @@ updatePostBuildProjectStatus verbosity distDirLayout
return currentBuildStatus
where
displayPackageIdSet = intercalate ", " . map display . Set.toList
displayPackageIdSet = intercalate ", " . map prettyShow . Set.toList
-- | Helper for reading the cache file.
--
......@@ -836,7 +836,7 @@ argsEquivalentOfGhcEnvironmentFileGhc
selectGhcEnvironmentFilePackageDbs elaboratedInstallPlan
-- TODO use proper flags? but packageDbArgsDb is private
clearPackageDbStackFlag = ["-clear-package-db", "-global-package-db"]
packageIdFlag uid = ["-package-id", display uid]
packageIdFlag uid = ["-package-id", prettyShow uid]
-- We're producing an environment for users to use in ghci, so of course
......
......@@ -54,6 +54,8 @@ import System.Directory ( doesFileExist )
import System.FilePath ( (</>) )
import System.IO.Error ( isDoesNotExistError )
import Text.PrettyPrint ( ($+$) )
import Distribution.Parsec (Parsec (..))
import Distribution.Pretty (Pretty (..))
import qualified Text.PrettyPrint as Disp
import qualified Distribution.Deprecated.ParseUtils as ParseUtils ( Field(..) )
......@@ -144,7 +146,7 @@ loadUserConfig verbosity pkgEnvDir globalConfigLocation =
pkgEnvFieldDescrs :: ConstraintSource -> [FieldDescr PackageEnvironment]
pkgEnvFieldDescrs src =
[ commaNewLineListField "constraints"
(Text.disp . fst) ((\pc -> (pc, src)) `fmap` Text.parse)
(pretty . fst) ((\pc -> (pc, src)) `fmap` parsec)
(sortConstraints . configExConstraints
. savedConfigureExFlags . pkgEnvSavedConfig)
(\v pkgEnv -> updateConfigureExFlags pkgEnv
......
......@@ -60,8 +60,6 @@ module Distribution.Client.Setup
import Prelude ()
import Distribution.Client.Compat.Prelude hiding (get)
import Distribution.Deprecated.ReadP (readP_to_E)
import Distribution.Client.Types.Credentials (Username (..), Password (..))
import Distribution.Client.Types.Repo (RemoteRepo(..), LocalRepo (..))
import Distribution.Client.Types.AllowNewer (AllowNewer(..), AllowOlder(..), RelaxDeps(..))
......@@ -81,7 +79,7 @@ import Distribution.Client.Targets
( UserConstraint, readUserConstraint )
import Distribution.Utils.NubList
( NubList, toNubList, fromNubList)
import Distribution.Parsec (CabalParsing, simpleParsec, parsec, eitherParsec )
import Distribution.Parsec (CabalParsing, simpleParsec, parsec, eitherParsec)
import Distribution.Pretty (prettyShow)
import Distribution.Solver.Types.ConstraintSource
......@@ -121,13 +119,9 @@ import Distribution.Types.UnqualComponentName
import Distribution.PackageDescription
( BuildType(..), RepoKind(..), LibraryName(..) )
import Distribution.System ( Platform )
import Distribution.Deprecated.Text
( Text(..), display )
import qualified Distribution.Compat.CharParsing as P
import Distribution.ReadE
( ReadE(..), succeedReadE, parsecToReadE )
import qualified Distribution.Deprecated.ReadP as Parse
( char, sepBy1 )
import qualified Distribution.Compat.CharParsing as P
import Distribution.Verbosity
( Verbosity, lessVerbose, normal, verboseNoFlags, verboseNoTimestamp )
import Distribution.Simple.Utils
......@@ -653,23 +647,23 @@ configureExOptions _showOrParseArgs src =
("Select which version of the Cabal lib to use to build packages "
++ "(useful for testing).")
configCabalVersion (\v flags -> flags { configCabalVersion = v })
(reqArg "VERSION" (readP_to_E ("Cannot parse cabal lib version: "++)
(fmap toFlag parse))
(map display . flagToList))
(reqArg "VERSION" (parsecToReadE ("Cannot parse cabal lib version: "++)
(fmap toFlag parsec))
(map prettyShow. flagToList))
, option [] ["constraint"]
"Specify constraints on a package (version, installed/source, flags)"
configExConstraints (\v flags -> flags { configExConstraints = v })
(reqArg "CONSTRAINT"
((\x -> [(x, src)]) `fmap` ReadE readUserConstraint)
(map $ display . fst))
(map $ prettyShow . fst))
, option [] ["preference"]
"Specify preferences (soft constraints) on the version of a package"
configPreferences (\v flags -> flags { configPreferences = v })
(reqArg "CONSTRAINT"
(readP_to_E (const "dependency expected")
(fmap (\x -> [x]) parse))
(map display))
(parsecToReadE (const "dependency expected")
(fmap (\x -> [x]) parsec))
(map prettyShow))
, optionSolver configSolver (\v flags -> flags { configSolver = v })
......@@ -678,7 +672,7 @@ configureExOptions _showOrParseArgs src =
(fmap unAllowOlder . configAllowOlder)
(\v flags -> flags { configAllowOlder = fmap AllowOlder v})
(optArg "DEPS"
(readP_to_E ("Cannot parse the list of packages: " ++) relaxDepsParser)
(parsecToReadE ("Cannot parse the list of packages: " ++) relaxDepsParser)
(Just RelaxDepsAll) relaxDepsPrinter)
, option [] ["allow-newer"]
......@@ -686,7 +680,7 @@ configureExOptions _showOrParseArgs src =
(fmap unAllowNewer . configAllowNewer)
(\v flags -> flags { configAllowNewer = fmap AllowNewer v})
(optArg "DEPS"
(readP_to_E ("Cannot parse the list of packages: " ++) relaxDepsParser)
(parsecToReadE ("Cannot parse the list of packages: " ++) relaxDepsParser)
(Just RelaxDepsAll) relaxDepsPrinter)
, option [] ["write-ghc-environment-files"]
......@@ -1235,7 +1229,7 @@ outdatedCommand = CommandUI {
,option [] ["ignore"]
"Packages to ignore"
outdatedIgnore (\v flags -> flags { outdatedIgnore = v })
(reqArg "PKGS" pkgNameListParser (map display))
(reqArg "PKGS" pkgNameListParser (map prettyShow))
,option [] ["minor"]
"Ignore major version bumps for these packages"
......@@ -1251,14 +1245,14 @@ outdatedCommand = CommandUI {
ignoreMajorVersionBumpsPrinter (Just IgnoreMajorVersionBumpsNone)= []
ignoreMajorVersionBumpsPrinter (Just IgnoreMajorVersionBumpsAll) = [Nothing]
ignoreMajorVersionBumpsPrinter (Just (IgnoreMajorVersionBumpsSome pkgs)) =
map (Just . display) $ pkgs
map (Just . prettyShow) $ pkgs
ignoreMajorVersionBumpsParser =
(Just . IgnoreMajorVersionBumpsSome) `fmap` pkgNameListParser
pkgNameListParser = readP_to_E
pkgNameListParser = parsecToReadE
("Couldn't parse the list of package names: " ++)
(Parse.sepBy1 parse (Parse.char ','))
(fmap toList (P.sepByNonEmpty parsec (P.char ',')))
-- ------------------------------------------------------------
-- * Update command
......@@ -1480,8 +1474,8 @@ getCommand = CommandUI {
,option "s" ["source-repository"]
"Copy the package's source repository (ie git clone, darcs get, etc as appropriate)."
getSourceRepository (\v flags -> flags { getSourceRepository = v })
(optArg "[head|this|...]" (readP_to_E (const "invalid source-repository")
(fmap (toFlag . Just) parse))
(optArg "[head|this|...]" (parsecToReadE (const "invalid source-repository")
(fmap (toFlag . Just) parsec))
(Flag Nothing)
(map (fmap show) . flagToList))
......@@ -1747,7 +1741,7 @@ defaultSolver :: PreSolver
defaultSolver = AlwaysModular
allSolvers :: String
allSolvers = intercalate ", " (map display ([minBound .. maxBound] :: [PreSolver]))
allSolvers = intercalate ", " (map prettyShow ([minBound .. maxBound] :: [PreSolver]))
installCommand :: CommandUI ( ConfigFlags, ConfigExFlags, InstallFlags
, HaddockFlags, TestFlags, BenchmarkFlags
......@@ -2005,10 +1999,10 @@ installOptions showOrParseArgs =
, option [] ["remote-build-reporting"]
"Generate build reports to send to a remote server (none, anonymous or detailed)."
installBuildReports (\v flags -> flags { installBuildReports = v })
(reqArg "LEVEL" (readP_to_E (const $ "report level must be 'none', "
(reqArg "LEVEL" (parsecToReadE (const $ "report level must be 'none', "
++ "'anonymous' or 'detailed'")
(toFlag `fmap` parse))
(flagToList . fmap display))
(toFlag `fmap` parsec))
(flagToList . fmap prettyShow))
, option [] ["report-planning-failure"]
"Generate build reports when the dependency solver fails. This is used by the Hackage build bot."
......@@ -2307,32 +2301,32 @@ initOptions _ =
"Specify the default language."
IT.language
(\v flags -> flags { IT.language = v })
(reqArg "LANGUAGE" (readP_to_E ("Cannot parse language: "++)
(toFlag `fmap` parse))
(flagToList . fmap display))
(reqArg "LANGUAGE" (parsecToReadE ("Cannot parse language: "++)
(toFlag `fmap` parsec))
(flagToList . fmap prettyShow))
, option ['o'] ["expose-module"]
"Export a module from the package."
IT.exposedModules
(\v flags -> flags { IT.exposedModules = v })
(reqArg "MODULE" (readP_to_E ("Cannot parse module name: "++)
((Just . (:[])) `fmap` parse))
(maybe [] (fmap display)))
(reqArg "MODULE" (parsecToReadE ("Cannot parse module name: "++)
((Just . (:[])) `fmap` parsec))
(maybe [] (fmap prettyShow)))
, option [] ["extension"]
"Use a LANGUAGE extension (in the other-extensions field)."
IT.otherExts
(\v flags -> flags { IT.otherExts = v })
(reqArg "EXTENSION" (readP_to_E ("Cannot parse extension: "++)
((Just . (:[])) `fmap` parse))
(maybe [] (fmap display)))
(reqArg "EXTENSION" (parsecToReadE ("Cannot parse extension: "++)
((Just . (:[])) `fmap` parsec))
(maybe [] (fmap prettyShow)))
, option ['d'] ["dependency"]
"Package dependency."