Commit 98e84342 authored by Robert Henderson's avatar Robert Henderson

Moved 'dispFlagAssignment' and 'parseFlagAssignment'.

I moved these functions to GenericPackageDescription.hs, where
the FlagAssignment type is defined.
parent 356f91c5
......@@ -93,6 +93,7 @@ module Distribution.PackageDescription (
Flag(..), emptyFlag,
FlagName, mkFlagName, unFlagName,
FlagAssignment,
dispFlagAssignment, parseFlagAssignment,
CondTree(..), ConfVar(..), Condition(..),
cNot, cAnd, cOr,
......
......@@ -12,6 +12,8 @@ module Distribution.Types.GenericPackageDescription (
mkFlagName,
unFlagName,
FlagAssignment,
dispFlagAssignment,
parseFlagAssignment,
ConfVar(..),
Condition(..),
CondTree(..),
......@@ -23,6 +25,10 @@ module Distribution.Types.GenericPackageDescription (
import Prelude ()
import Distribution.Compat.Prelude
import Distribution.Utils.ShortText
import Distribution.Utils.Generic (lowercase)
import qualified Text.PrettyPrint as Disp
import qualified Distribution.Compat.ReadP as Parse
import Distribution.Compat.ReadP ((+++))
import Distribution.Types.PackageDescription
......@@ -117,6 +123,34 @@ instance Binary FlagName
--
type FlagAssignment = [(FlagName, Bool)]
-- | Pretty-prints a flag assignment.
dispFlagAssignment :: FlagAssignment -> Disp.Doc
dispFlagAssignment = Disp.hsep . map dispFlagValue
where
dispFlagValue (f, True) = Disp.char '+' <<>> dispFlagName f
dispFlagValue (f, False) = Disp.char '-' <<>> dispFlagName f
dispFlagName = Disp.text . unFlagName
-- | Parses a flag assignment.
parseFlagAssignment :: Parse.ReadP r FlagAssignment
parseFlagAssignment = Parse.sepBy1 parseFlagValue Parse.skipSpaces1
where
parseFlagValue =
(do Parse.optional (Parse.char '+')
f <- parseFlagName
return (f, True))
+++ (do _ <- Parse.char '-'
f <- parseFlagName
return (f, False))
parseFlagName = liftM (mkFlagName . lowercase) ident
ident :: Parse.ReadP r String
ident = Parse.munch1 identChar >>= \s -> check s >> return s
where
identChar c = isAlphaNum c || c == '_' || c == '-'
check ('-':_) = Parse.pfail
check _ = return ()
-- | A @ConfVar@ represents the variable type used.
data ConfVar = OS OS
| Arch Arch
......
......@@ -34,7 +34,8 @@ import Distribution.Solver.Types.ConstraintSource
import Distribution.Package
import Distribution.Types.Dependency
import Distribution.PackageDescription
( SourceRepo(..), RepoKind(..) )
( SourceRepo(..), RepoKind(..)
, dispFlagAssignment, parseFlagAssignment )
import Distribution.PackageDescription.Parse
( sourceRepoFieldDescrs )
import Distribution.Simple.Compiler
......@@ -53,8 +54,6 @@ import Distribution.Simple.Program
( programName, knownPrograms )
import Distribution.Simple.Program.Db
( ProgramDb, defaultProgramDb )
import Distribution.Client.Targets
( dispFlagAssignment, parseFlagAssignment )
import Distribution.Simple.Utils
( lowercase )
import Distribution.Utils.NubList
......
......@@ -45,8 +45,6 @@ module Distribution.Client.Targets (
userConstraintPackageName,
readUserConstraint,
userToPackageConstraint,
dispFlagAssignment,
parseFlagAssignment,
) where
......@@ -79,7 +77,8 @@ import Distribution.Client.GlobalFlags
( RepoContext(..) )
import Distribution.PackageDescription
( GenericPackageDescription, mkFlagName, unFlagName, FlagAssignment )
( GenericPackageDescription, FlagAssignment
, dispFlagAssignment, parseFlagAssignment )
import Distribution.PackageDescription.Parse
( readPackageDescription, parsePackageDescription, ParseResult(..) )
import Distribution.Version
......@@ -779,30 +778,3 @@ instance Text UserConstraint where
<++ (do Parse.skipSpaces1
flags <- parseFlagAssignment
return (UserConstraintFlags pkgname flags))
--TODO: [code cleanup] move these somewhere else
dispFlagAssignment :: FlagAssignment -> Disp.Doc
dispFlagAssignment = Disp.hsep . map dispFlagValue
where
dispFlagValue (f, True) = Disp.char '+' <<>> dispFlagName f
dispFlagValue (f, False) = Disp.char '-' <<>> dispFlagName f
dispFlagName = Disp.text . unFlagName
parseFlagAssignment :: Parse.ReadP r FlagAssignment
parseFlagAssignment = Parse.sepBy1 parseFlagValue Parse.skipSpaces1
where
parseFlagValue =
(do Parse.optional (Parse.char '+')
f <- parseFlagName
return (f, True))
+++ (do _ <- Parse.char '-'
f <- parseFlagName
return (f, False))
parseFlagName = liftM (mkFlagName . lowercase) ident
ident :: Parse.ReadP r String
ident = Parse.munch1 identChar >>= \s -> check s >> return s
where
identChar c = isAlphaNum c || c == '_' || c == '-'
check ('-':_) = Parse.pfail
check _ = return ()
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