Commit 06a140f3 authored by Oleg Grenrus's avatar Oleg Grenrus

Use Pretty/Parsec in Init (remote Text Category instance)

parent c753f62a
......@@ -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
......
......@@ -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
......
......@@ -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,10 +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 GHC.Generics ( Generic )
import qualified Distribution.Compat.CharParsing as P
import qualified Data.Map as Map
import Distribution.Pretty (Pretty (..))
import Distribution.Parsec (Parsec (..))
-- | InitFlags is really just a simple type to represent certain
-- portions of a .cabal file. Rather than have a flag for EVERY
......@@ -129,6 +131,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 ] ]
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment