Commit eb958ae2 authored by refold's avatar refold
Browse files

showPkgEnv: print empty fields commented-out.

parent 40db8d7f
......@@ -6,27 +6,26 @@
--
-- Utilities for working with the package environment file. Patterned after
-- Distribution.Client.Config.
--
--
-----------------------------------------------------------------------------
module Distribution.Client.PkgEnv (dumpPkgEnv)
where
import Distribution.Client.Config ( SavedConfig(..), baseSavedConfig,
configFieldDescriptions )
import Distribution.Client.Setup ( SandboxFlags(..) )
import Distribution.Simple.Setup ( Flag(..), fromFlagOrDefault, toFlag )
import Distribution.Simple.Utils ( notice, warn )
import Distribution.ParseUtils ( FieldDescr(..), ParseResult(..),
import Distribution.Client.Config ( SavedConfig(..), baseSavedConfig,
configFieldDescriptions )
import Distribution.Client.ParseUtils ( ppFields )
import Distribution.Client.Setup ( SandboxFlags(..) )
import Distribution.Simple.Setup ( Flag(..), fromFlagOrDefault, toFlag )
import Distribution.Simple.Utils ( notice, warn )
import Distribution.ParseUtils ( FieldDescr(..), ParseResult(..),
parseFilePathQ, parseFields,
liftField, ppFields, simpleField )
import Distribution.Verbosity ( Verbosity )
import Data.Monoid ( Monoid(..) )
import Distribution.Compat.Exception ( catchIO )
import System.Directory ( createDirectoryIfMissing, renameFile )
import System.FilePath ( (<.>), takeDirectory )
import System.IO.Error ( isDoesNotExistError )
liftField, simpleField )
import Distribution.Verbosity ( Verbosity )
import Data.Monoid ( Monoid(..) )
import Distribution.Compat.Exception ( catchIO )
import System.Directory ( createDirectoryIfMissing, renameFile )
import System.FilePath ( (<.>), takeDirectory )
import System.IO.Error ( isDoesNotExistError )
import qualified Text.PrettyPrint as Disp
import qualified Distribution.Compat.ReadP as Parse
......@@ -35,7 +34,7 @@ import qualified Distribution.Compat.ReadP as Parse
-- * Configuration saved in the package environment file
--
-- TODO: Print w/comments & defaults, install-dirs section, constraints field
-- TODO: install-dirs section, constraints field, sensible defaults
data PkgEnv = PkgEnv {
pkgEnvInherit :: Flag FilePath,
pkgEnvSavedConfig :: SavedConfig
......@@ -57,6 +56,10 @@ instance Monoid PkgEnv where
where
combine f = f a `mappend` f b
basePkgEnv :: IO PkgEnv
basePkgEnv = do baseConf <- baseSavedConfig
return $ mempty { pkgEnvSavedConfig = baseConf }
-- | Entry point for the 'cabal dump-pkgenv' command.
dumpPkgEnv :: Verbosity -> SandboxFlags -> FilePath -> IO ()
dumpPkgEnv verbosity sandboxFlags path = do
......@@ -67,16 +70,15 @@ dumpPkgEnv verbosity sandboxFlags path = do
Just (ParseFailed err)
-> warn verbosity $ "Failed to parse file '" ++ path ++ "'."
Just (ParseOk warns pkgEnv)
-> do base <- baseSavedConfig
let pkgEnv' = pkgEnv { pkgEnvSavedConfig =
base `mappend` pkgEnvSavedConfig pkgEnv }
putStrLn . showPkgEnv $ pkgEnv'
-> do base <- basePkgEnv
let pkgEnv' = base `mappend` pkgEnv
putStrLn . showPkgEnvWithComments base $ mempty
-- | Descriptions of all fields in the package environment file.
pkgEnvFieldDescrs :: [FieldDescr PkgEnv]
pkgEnvFieldDescrs = [
simpleField "inherit"
(Disp.text . fromFlagOrDefault "") (optional parseFilePathQ)
(fromFlagOrDefault Disp.empty . fmap Disp.text) (optional parseFilePathQ)
pkgEnvInherit (\v pkgEnv -> pkgEnv { pkgEnvInherit = v })
]
++ map toPkgEnv configFieldDescriptions
......@@ -113,5 +115,9 @@ writePkgEnvFile path pkgEnv = do
-- | Pretty-print the package environment data.
showPkgEnv :: PkgEnv -> String
showPkgEnv pkgEnv = Disp.render $
ppFields pkgEnvFieldDescrs pkgEnv
showPkgEnv = showPkgEnvWithComments mempty
showPkgEnvWithComments :: PkgEnv -> PkgEnv -> String
showPkgEnvWithComments defPkgEnv pkgEnv =
Disp.render $
ppFields pkgEnvFieldDescrs defPkgEnv pkgEnv
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