Remove few more Text instances

cabal-install/Distribution/Client/BuildReports/Anonymous.hs

@@ -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 })

cabal-install/Distribution/Client/Config.hs

@@ -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

cabal-install/Distribution/Client/Get.hs

@@ -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) $

cabal-install/Distribution/Client/ProjectPlanOutput.hs

@@ -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

cabal-install/Distribution/Client/SetupWrapper.hs

@@ -100,8 +100,7 @@ import Distribution.Client.Utils
 
 import Distribution.ReadE
 import Distribution.System ( Platform(..), buildPlatform )
-import Distribution.Deprecated.Text
-         ( display )
+import Distribution.Pretty (prettyShow)
 import Distribution.Utils.NubList
          ( toNubListR )
 import Distribution.Verbosity
@@ -477,7 +476,7 @@ runProcess' cmd args mb_cwd mb_env mb_stdin mb_stdout mb_stderr _delegate = do
 selfExecSetupMethod :: SetupRunner
 selfExecSetupMethod verbosity options bt args0 = do
   let args = ["act-as-setup",
-              "--build-type=" ++ display bt,
+              "--build-type=" ++ prettyShow bt,
               "--"] ++ args0
   info verbosity $ "Using self-exec internal setup method with build-type "
                  ++ show bt ++ " and args:\n  " ++ show args
@@ -570,7 +569,7 @@ getExternalSetupMethod verbosity options pkg bt = do
     ++ show (useDependenciesExclusive options)
   createDirectoryIfMissingVerbose verbosity True setupDir
   (cabalLibVersion, mCabalLibInstalledPkgId, options') <- cabalLibVersionToUse
-  debug verbosity $ "Using Cabal library version " ++ display cabalLibVersion
+  debug verbosity $ "Using Cabal library version " ++ prettyShow cabalLibVersion
   path <- if useCachedSetupExecutable
           then getCachedSetupExecutable options'
                cabalLibVersion mCabalLibInstalledPkgId
@@ -728,9 +727,9 @@ getExternalSetupMethod verbosity options pkg bt = do
         cabalDepVersion = useCabalVersion options'
         options''       = options' { usePackageIndex = Just index }
     case PackageIndex.lookupDependency index cabalDepName cabalDepVersion of
-      []   -> die' verbosity $ "The package '" ++ display (packageName pkg)
+      []   -> die' verbosity $ "The package '" ++ prettyShow (packageName pkg)
                  ++ "' requires Cabal library version "
-                 ++ display (useCabalVersion options)
+                 ++ prettyShow (useCabalVersion options)
                  ++ " but no suitable version is installed."
       pkgs -> let ipkginfo = fromMaybe err $ safeHead . snd . bestVersion fst $ pkgs
                   err = error "Distribution.Client.installedCabalVersion: empty version list"
@@ -799,11 +798,11 @@ getExternalSetupMethod verbosity options pkg bt = do
     return (setupCacheDir, cachedSetupProgFile)
       where
         buildTypeString       = show bt
-        cabalVersionString    = "Cabal-" ++ (display cabalLibVersion)
-        compilerVersionString = display $
+        cabalVersionString    = "Cabal-" ++ prettyShow cabalLibVersion
+        compilerVersionString = prettyShow $
                                 maybe buildCompilerId compilerId
                                   $ useCompiler options'
-        platformString        = display platform
+        platformString        = prettyShow platform
 
   -- | Look up the setup executable in the cache; update the cache if the setup
   -- executable is not found.

cabal-install/Distribution/Deprecated/ParseUtils.hs

@@ -39,7 +39,7 @@ module Distribution.Deprecated.ParseUtils (
         optsField, liftField, boolField, parseQuoted, parseMaybeQuoted,
         readPToMaybe,
 
-        fieldParsec, commaNewLineListFieldParsec,
+        fieldParsec, simpleFieldParsec, commaNewLineListFieldParsec,
 
         UnrecFieldParser, warnUnrec, ignoreUnrec,
   ) where
@@ -214,6 +214,11 @@ simpleField :: String -> (a -> Doc) -> ReadP a a
 simpleField name showF readF get set
   = liftField get set $ field name showF readF
 
+simpleFieldParsec :: String -> (a -> Doc) -> ParsecParser a
+            -> (b -> a) -> (a -> b -> b) -> FieldDescr b
+simpleFieldParsec name showF readF get set
+  = liftField get set $ fieldParsec name showF readF
+
 commaListFieldWithSep :: Separator -> String -> (a -> Doc) -> ReadP [a] a
                       -> (b -> [a]) -> ([a] -> b -> b) -> FieldDescr b
 commaListFieldWithSep separator name showF readF get set =

cabal-install/Distribution/Deprecated/Text.hs

@@ -45,7 +45,6 @@ import qualified Distribution.PackageDescription             as D
 import qualified Distribution.Simple.Setup                   as D
 import qualified Distribution.System                         as D
 import qualified Distribution.Types.PackageVersionConstraint as D
-import qualified Distribution.Types.SourceRepo               as D
 import qualified Distribution.Types.UnqualComponentName      as D
 import qualified Distribution.Version                        as D
 import qualified Language.Haskell.Extension                  as E
@@ -97,9 +96,6 @@ instance Text Bool where
                        , (Parse.string "False" Parse.+++
                           Parse.string "false") >> return False ]
 
-instance Text Int where
-  parse = fmap negate (Parse.char '-' >> parseNat) Parse.+++ parseNat
-
 instance Text a => Text (Identity a) where
     disp = disp . runIdentity
     parse = fmap Identity parse
@@ -123,20 +119,6 @@ instance Text Version where
 -- Instances
 -------------------------------------------------------------------------------
 
-instance Text D.Arch where
-  parse = fmap (D.classifyArch D.Strict) ident
-
-instance Text D.BuildType where
-  parse = do
-    name <- Parse.munch1 isAlphaNum
-    case name of
-      "Simple"    -> return D.Simple
-      "Configure" -> return D.Configure
-      "Custom"    -> return D.Custom
-      "Make"      -> return D.Make
-      "Default"   -> return D.Custom
-      _           -> fail ("unknown build-type: '" ++ name ++ "'")
-
 instance Text D.CompilerFlavor where
   parse = do
     comp <- Parse.munch1 isAlphaNum
@@ -275,12 +257,6 @@ instance Text D.Platform where
           where firstChar = Parse.satisfy isAlpha
                 rest = Parse.munch (\c -> isAlphaNum c || c == '_')
 
-instance Text D.RepoKind where
-  parse = fmap D.classifyRepoKind ident
-
-instance Text D.RepoType where
-  parse = fmap D.classifyRepoType ident
-
 instance Text D.UnqualComponentName where
   parse = D.mkUnqualComponentName <$> parsePackageName