diff --git a/cabal-install/Distribution/Client/Init/FileCreators.hs b/cabal-install/Distribution/Client/Init/FileCreators.hs index 111ccbac225..b4f936cf5f3 100644 --- a/cabal-install/Distribution/Client/Init/FileCreators.hs +++ b/cabal-install/Distribution/Client/Init/FileCreators.hs @@ -65,8 +65,6 @@ import Distribution.Client.Init.Types import Distribution.CabalSpecVersion import Distribution.Compat.Newtype ( Newtype ) -import Distribution.Deprecated.Text - ( display, Text(..) ) import Distribution.Fields.Field ( FieldName ) import Distribution.License @@ -166,8 +164,8 @@ writeChangeLog flags = when ((defaultChangeLog `elem`) $ fromMaybe [] (extraSrc , "" , "* First version. Released on an unsuspecting world." ] - pname = maybe "" display $ flagToMaybe $ packageName flags - pver = maybe "" display $ flagToMaybe $ version flags + pname = maybe "" prettyShow $ flagToMaybe $ packageName flags + pver = maybe "" prettyShow $ flagToMaybe $ version flags -- | Creates and writes the initialized .cabal file. -- @@ -177,7 +175,7 @@ writeCabalFile flags@(InitFlags{packageName = NoFlag}) = do message flags "Error: no package name provided." return False writeCabalFile flags@(InitFlags{packageName = Flag p}) = do - let cabalFileName = display p ++ ".cabal" + let cabalFileName = prettyShow p ++ ".cabal" message flags $ "Generating " ++ cabalFileName ++ "..." writeFileSafe flags cabalFileName (generateCabalFile cabalFileName flags) return True @@ -415,7 +413,7 @@ generateCabalFile fileName c = ["A copyright notice."] True - , fieldS "category" (either id display `fmap` category c) + , fieldS "category" (either id prettyShow `fmap` category c) [] True @@ -500,13 +498,13 @@ generateCabalFile fileName c = -- | Construct a 'PrettyField' from a field that can be automatically -- converted to a 'Doc' via 'display'. - field :: Text t + field :: Pretty t => FieldName -> Flag t -> [String] -> Bool -> Maybe (PrettyField FieldAnnotation) - field fieldName fieldContentsFlag = fieldS fieldName (display <$> fieldContentsFlag) + field fieldName fieldContentsFlag = fieldS fieldName (prettyShow <$> fieldContentsFlag) -- | Construct a 'PrettyField' from a 'String' field. fieldS :: FieldName -- ^ Name of the field @@ -596,7 +594,7 @@ generateCabalFile fileName c = ++ generateBuildInfo ExecBuild c where - exeName = text (maybe "" display . flagToMaybe $ packageName c) + exeName = text (maybe "" prettyShow . flagToMaybe $ packageName c) libraryStanza :: PrettyField FieldAnnotation libraryStanza = PrettySection annNoComments (toUTF8BS "library") [] $ catMaybes @@ -633,7 +631,7 @@ generateCabalFile fileName c = ] where testSuiteName = - text (maybe "" ((++"-test") . display) . flagToMaybe $ packageName c) + text (maybe "" ((++"-test") . prettyShow) . flagToMaybe $ packageName c) -- | Annotations for cabal file PrettyField. data FieldAnnotation = FieldAnnotation diff --git a/cabal-install/Distribution/Client/Init/Prompt.hs b/cabal-install/Distribution/Client/Init/Prompt.hs index fefa70a48ac..8b9ae8277eb 100644 --- a/cabal-install/Distribution/Client/Init/Prompt.hs +++ b/cabal-install/Distribution/Client/Init/Prompt.hs @@ -26,17 +26,15 @@ module Distribution.Client.Init.Prompt ( import Prelude () import Distribution.Client.Compat.Prelude hiding (empty) -import Distribution.Deprecated.ReadP (readP_to_E) - import Control.Monad ( mapM_ ) import Distribution.Client.Init.Types ( InitFlags(..) ) -import Distribution.Deprecated.Text - ( display, Text(..) ) -import Distribution.ReadE - ( runReadE ) +import Distribution.Parsec + ( Parsec, simpleParsec ) +import Distribution.Pretty + ( Pretty, prettyShow ) import Distribution.Simple.Setup ( Flag(..) ) @@ -69,10 +67,8 @@ promptYesNo = -- | Create a prompt with optional default value that returns a value -- of some Text instance. -prompt :: Text t => String -> Maybe t -> IO t -prompt = promptDefault' - (either (const Nothing) Just . runReadE (readP_to_E id parse)) - display +prompt :: (Parsec t, Pretty t) => String -> Maybe t -> IO t +prompt = promptDefault' simpleParsec prettyShow -- | Create a prompt with an optional default value. promptDefault' :: (String -> Maybe t) -- ^ parser @@ -99,11 +95,11 @@ mkDefPrompt pr def = pr ++ "?" ++ defStr def -- | Create a prompt from a list of items, where no selected items is -- valid and will be represented as a return value of 'Nothing'. -promptListOptional :: (Text t, Eq t) +promptListOptional :: (Pretty t, Eq t) => String -- ^ prompt -> [t] -- ^ choices -> IO (Maybe (Either String t)) -promptListOptional pr choices = promptListOptional' pr choices display +promptListOptional pr choices = promptListOptional' pr choices prettyShow promptListOptional' :: Eq t => String -- ^ prompt diff --git a/cabal-install/Distribution/Client/Init/Types.hs b/cabal-install/Distribution/Client/Init/Types.hs index d9274df6b47..a7fcb711df0 100644 --- a/cabal-install/Distribution/Client/Init/Types.hs +++ b/cabal-install/Distribution/Client/Init/Types.hs @@ -15,10 +15,12 @@ ----------------------------------------------------------------------------- module Distribution.Client.Init.Types where +import Distribution.Client.Compat.Prelude +import Prelude () + import Distribution.Simple.Setup (Flag(..), toFlag ) import Distribution.Types.Dependency as P -import Distribution.Compat.Semigroup import Distribution.Version import Distribution.Verbosity import qualified Distribution.Package as P @@ -28,8 +30,10 @@ import Distribution.CabalSpecVersion import Language.Haskell.Extension ( Language(..), Extension ) import qualified Text.PrettyPrint as Disp -import qualified Distribution.Deprecated.ReadP as Parse -import Distribution.Deprecated.Text +import qualified Distribution.Compat.CharParsing as P +import qualified Data.Map as Map +import Distribution.Pretty (Pretty (..)) +import Distribution.Parsec (Parsec (..)) import GHC.Generics ( Generic ) @@ -129,6 +133,14 @@ data Category | Web deriving (Read, Show, Eq, Ord, Bounded, Enum) -instance Text Category where - disp = Disp.text . show - parse = Parse.choice $ map (fmap read . Parse.string . show) [Codec .. ] -- TODO: eradicateNoParse +instance Pretty Category where + pretty = Disp.text . show + +instance Parsec Category where + parsec = do + name <- P.munch1 isAlpha + case Map.lookup name names of + Just cat -> pure cat + _ -> P.unexpected $ "Category: " ++ name + where + names = Map.fromList [ (show cat, cat) | cat <- [ minBound .. maxBound ] ]