Distribution/Types/GenericPackageDescription.hs

    {-# LANGUAGE DeriveDataTypeable #-}
    {-# LANGUAGE DeriveGeneric #-}

    module Distribution.Types.GenericPackageDescription (
        GenericPackageDescription(..),
        Flag(..),
        emptyFlag,
        FlagName,
        mkFlagName,
        unFlagName,
        FlagAssignment,
        showFlagValue,
        dispFlagAssignment,
        parseFlagAssignment,
        ConfVar(..),
    ) where

    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

    import Distribution.Types.Dependency
    import Distribution.Types.Library
    import Distribution.Types.ForeignLib
    import Distribution.Types.Executable
    import Distribution.Types.TestSuite
    import Distribution.Types.Benchmark
    import Distribution.Types.UnqualComponentName
    import Distribution.Types.CondTree

    import Distribution.Package
    import Distribution.Version
    import Distribution.Compiler
    import Distribution.System

    -- ---------------------------------------------------------------------------
    -- The GenericPackageDescription type

    data GenericPackageDescription =
        GenericPackageDescription {
            packageDescription :: PackageDescription,
            genPackageFlags    :: [Flag],
            condLibrary        :: Maybe (CondTree ConfVar [Dependency] Library),
            condSubLibraries   :: [(UnqualComponentName, CondTree ConfVar [Dependency] Library)],
            condForeignLibs    :: [(UnqualComponentName, CondTree ConfVar [Dependency] ForeignLib)],
            condExecutables    :: [(UnqualComponentName, CondTree ConfVar [Dependency] Executable)],
            condTestSuites     :: [(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)],
            condBenchmarks     :: [(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)]
          }
        deriving (Show, Eq, Typeable, Data, Generic)

    instance Package GenericPackageDescription where
      packageId = packageId . packageDescription

    instance Binary GenericPackageDescription

    -- | A flag can represent a feature to be included, or a way of linking
    --   a target against its dependencies, or in fact whatever you can think of.
    data Flag = MkFlag
        { flagName        :: FlagName
        , flagDescription :: String
        , flagDefault     :: Bool
        , flagManual      :: Bool
        }
        deriving (Show, Eq, Typeable, Data, Generic)

    instance Binary Flag

    -- | A 'Flag' initialized with default parameters.
    emptyFlag :: FlagName -> Flag
    emptyFlag name = MkFlag
        { flagName        = name
        , flagDescription = ""
        , flagDefault     = True
        , flagManual      = False
        }

    -- | A 'FlagName' is the name of a user-defined configuration flag
    --
    -- Use 'mkFlagName' and 'unFlagName' to convert from/to a 'String'.
    --
    -- This type is opaque since @Cabal-2.0@
    --
    -- @since 2.0.0.2
    newtype FlagName = FlagName ShortText
        deriving (Eq, Generic, Ord, Show, Read, Typeable, Data)

    -- | Construct a 'FlagName' from a 'String'
    --
    -- 'mkFlagName' is the inverse to 'unFlagName'
    --
    -- Note: No validations are performed to ensure that the resulting
    -- 'FlagName' is valid
    --
    -- @since 2.0.0.2
    mkFlagName :: String -> FlagName
    mkFlagName = FlagName . toShortText

    -- | 'mkFlagName'
    --
    -- @since 2.0.0.2
    instance IsString FlagName where
        fromString = mkFlagName

    -- | Convert 'FlagName' to 'String'
    --
    -- @since 2.0.0.2
    unFlagName :: FlagName -> String
    unFlagName (FlagName s) = fromShortText s

    instance Binary FlagName

    -- | A 'FlagAssignment' is a total or partial mapping of 'FlagName's to
    -- 'Bool' flag values. It represents the flags chosen by the user or
    -- discovered during configuration. For example @--flags=foo --flags=-bar@
    -- becomes @[("foo", True), ("bar", False)]@
    --
    type FlagAssignment = [(FlagName, Bool)]

    -- | String representation of a flag-value pair.
    showFlagValue :: (FlagName, Bool) -> String
    showFlagValue (f, True)   = '+' : unFlagName f
    showFlagValue (f, False)  = '-' : unFlagName f

    -- | Pretty-prints a flag assignment.
    dispFlagAssignment :: FlagAssignment -> Disp.Doc
    dispFlagAssignment = Disp.hsep . map (Disp.text . showFlagValue)

    -- | Parses a flag assignment.
    parseFlagAssignment :: Parse.ReadP r FlagAssignment
    parseFlagAssignment = Parse.sepBy 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
                 | Flag FlagName
                 | Impl CompilerFlavor VersionRange
        deriving (Eq, Show, Typeable, Data, Generic)

    instance Binary ConfVar