{-# LANGUAGE DeriveGeneric #-}
module Distribution.Client.Sandbox.PackageEnvironment (
PackageEnvironment(..)
, PackageEnvironmentType(..)
, classifyPackageEnvironment
, readPackageEnvironmentFile
, showPackageEnvironment
, showPackageEnvironmentWithComments
, loadUserConfig
, userPackageEnvironmentFile
) where
import Distribution.Client.Compat.Prelude
import Prelude ()
import Distribution.Client.Config ( SavedConfig(..)
, configFieldDescriptions
, haddockFlagsFields
, installDirsFields, withProgramsFields
, withProgramOptionsFields
)
import Distribution.Client.ParseUtils ( parseFields, ppFields, ppSection )
import Distribution.Client.Setup ( ConfigExFlags(..)
)
import Distribution.Client.Targets ( userConstraintPackageName )
import Distribution.Simple.InstallDirs ( InstallDirs(..), PathTemplate )
import Distribution.Simple.Setup ( Flag(..)
, ConfigFlags(..), HaddockFlags(..)
)
import Distribution.Simple.Utils ( warn, debug )
import Distribution.Solver.Types.ConstraintSource
import Distribution.Deprecated.ParseUtils ( FieldDescr(..), ParseResult(..)
, commaListFieldParsec, commaNewLineListFieldParsec
, liftField, lineNo, locatedErrorMsg
, readFields
, showPWarning
, syntaxError, warning )
import System.Directory ( doesFileExist )
import System.FilePath ( (</>) )
import System.IO.Error ( isDoesNotExistError )
import Text.PrettyPrint ( ($+$) )
import qualified Data.ByteString as BS
import qualified Text.PrettyPrint as Disp
import qualified Distribution.Deprecated.ParseUtils as ParseUtils ( Field(..) )
data PackageEnvironment = PackageEnvironment {
PackageEnvironment -> SavedConfig
pkgEnvSavedConfig :: SavedConfig
} deriving forall x. Rep PackageEnvironment x -> PackageEnvironment
forall x. PackageEnvironment -> Rep PackageEnvironment x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PackageEnvironment x -> PackageEnvironment
$cfrom :: forall x. PackageEnvironment -> Rep PackageEnvironment x
Generic
instance Monoid PackageEnvironment where
mempty :: PackageEnvironment
mempty = forall a. (Generic a, GMonoid (Rep a)) => a
gmempty
mappend :: PackageEnvironment -> PackageEnvironment -> PackageEnvironment
mappend = forall a. Semigroup a => a -> a -> a
(<>)
instance Semigroup PackageEnvironment where
<> :: PackageEnvironment -> PackageEnvironment -> PackageEnvironment
(<>) = forall a. (Generic a, GSemigroup (Rep a)) => a -> a -> a
gmappend
userPackageEnvironmentFile :: FilePath
userPackageEnvironmentFile :: String
userPackageEnvironmentFile = String
"cabal.config"
data PackageEnvironmentType
= UserPackageEnvironment
| AmbientPackageEnvironment
classifyPackageEnvironment :: FilePath -> IO PackageEnvironmentType
classifyPackageEnvironment :: String -> IO PackageEnvironmentType
classifyPackageEnvironment String
pkgEnvDir = do
Bool
isUser <- String -> IO Bool
configExists String
userPackageEnvironmentFile
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> PackageEnvironmentType
classify Bool
isUser)
where
configExists :: String -> IO Bool
configExists String
fname = String -> IO Bool
doesFileExist (String
pkgEnvDir String -> String -> String
</> String
fname)
classify :: Bool -> PackageEnvironmentType
classify :: Bool -> PackageEnvironmentType
classify Bool
True = PackageEnvironmentType
UserPackageEnvironment
classify Bool
False = PackageEnvironmentType
AmbientPackageEnvironment
userPackageEnvironment :: Verbosity -> FilePath -> Maybe FilePath
-> IO PackageEnvironment
userPackageEnvironment :: Verbosity -> String -> Maybe String -> IO PackageEnvironment
userPackageEnvironment Verbosity
verbosity String
pkgEnvDir Maybe String
globalConfigLocation = do
let path :: String
path = String
pkgEnvDir String -> String -> String
</> String
userPackageEnvironmentFile
Maybe (ParseResult PackageEnvironment)
minp <- ConstraintSource
-> PackageEnvironment
-> String
-> IO (Maybe (ParseResult PackageEnvironment))
readPackageEnvironmentFile (String -> ConstraintSource
ConstraintSourceUserConfig String
path)
forall a. Monoid a => a
mempty String
path
case (Maybe (ParseResult PackageEnvironment)
minp, Maybe String
globalConfigLocation) of
(Just ParseResult PackageEnvironment
parseRes, Maybe String
_) -> forall {b}. Monoid b => String -> ParseResult b -> IO b
processConfigParse String
path ParseResult PackageEnvironment
parseRes
(Maybe (ParseResult PackageEnvironment)
_, Just String
globalLoc) -> do
Maybe (ParseResult PackageEnvironment)
minp' <- ConstraintSource
-> PackageEnvironment
-> String
-> IO (Maybe (ParseResult PackageEnvironment))
readPackageEnvironmentFile (String -> ConstraintSource
ConstraintSourceUserConfig String
globalLoc)
forall a. Monoid a => a
mempty String
globalLoc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Verbosity -> String -> IO ()
warn Verbosity
verbosity (String
"no constraints file found at " forall a. [a] -> [a] -> [a]
++ String
globalLoc)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Monoid a => a
mempty)
(forall {b}. Monoid b => String -> ParseResult b -> IO b
processConfigParse String
globalLoc)
Maybe (ParseResult PackageEnvironment)
minp'
(Maybe (ParseResult PackageEnvironment), Maybe String)
_ -> do
Verbosity -> String -> IO ()
debug Verbosity
verbosity (String
"no user package environment file found at " forall a. [a] -> [a] -> [a]
++ String
pkgEnvDir)
forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Monoid a => a
mempty
where
processConfigParse :: String -> ParseResult b -> IO b
processConfigParse String
path (ParseOk [PWarning]
warns b
parseResult) = do
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [PWarning]
warns) forall a b. (a -> b) -> a -> b
$ Verbosity -> String -> IO ()
warn Verbosity
verbosity forall a b. (a -> b) -> a -> b
$
[String] -> String
unlines (forall a b. (a -> b) -> [a] -> [b]
map (String -> PWarning -> String
showPWarning String
path) [PWarning]
warns)
forall (m :: * -> *) a. Monad m => a -> m a
return b
parseResult
processConfigParse String
path (ParseFailed PError
err) = do
let (Maybe LineNo
line, String
msg) = PError -> (Maybe LineNo, String)
locatedErrorMsg PError
err
Verbosity -> String -> IO ()
warn Verbosity
verbosity forall a b. (a -> b) -> a -> b
$ String
"Error parsing package environment file " forall a. [a] -> [a] -> [a]
++ String
path
forall a. [a] -> [a] -> [a]
++ forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" (\LineNo
n -> String
":" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show LineNo
n) Maybe LineNo
line forall a. [a] -> [a] -> [a]
++ String
":\n" forall a. [a] -> [a] -> [a]
++ String
msg
forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Monoid a => a
mempty
loadUserConfig :: Verbosity -> FilePath -> Maybe FilePath -> IO SavedConfig
loadUserConfig :: Verbosity -> String -> Maybe String -> IO SavedConfig
loadUserConfig Verbosity
verbosity String
pkgEnvDir Maybe String
globalConfigLocation =
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PackageEnvironment -> SavedConfig
pkgEnvSavedConfig forall a b. (a -> b) -> a -> b
$
Verbosity -> String -> Maybe String -> IO PackageEnvironment
userPackageEnvironment Verbosity
verbosity String
pkgEnvDir Maybe String
globalConfigLocation
pkgEnvFieldDescrs :: ConstraintSource -> [FieldDescr PackageEnvironment]
pkgEnvFieldDescrs :: ConstraintSource -> [FieldDescr PackageEnvironment]
pkgEnvFieldDescrs ConstraintSource
src =
[ forall a b.
String
-> (a -> Doc)
-> ParsecParser a
-> (b -> [a])
-> ([a] -> b -> b)
-> FieldDescr b
commaNewLineListFieldParsec String
"constraints"
(forall a. Pretty a => a -> Doc
pretty forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) ((\UserConstraint
pc -> (UserConstraint
pc, ConstraintSource
src)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
parsec)
(forall {b}. [(UserConstraint, b)] -> [(UserConstraint, b)]
sortConstraints forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConfigExFlags -> [(UserConstraint, ConstraintSource)]
configExConstraints
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SavedConfig -> ConfigExFlags
savedConfigureExFlags forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageEnvironment -> SavedConfig
pkgEnvSavedConfig)
(\[(UserConstraint, ConstraintSource)]
v PackageEnvironment
pkgEnv -> PackageEnvironment
-> (ConfigExFlags -> ConfigExFlags) -> PackageEnvironment
updateConfigureExFlags PackageEnvironment
pkgEnv
(\ConfigExFlags
flags -> ConfigExFlags
flags { configExConstraints :: [(UserConstraint, ConstraintSource)]
configExConstraints = [(UserConstraint, ConstraintSource)]
v }))
, forall a b.
String
-> (a -> Doc)
-> ParsecParser a
-> (b -> [a])
-> ([a] -> b -> b)
-> FieldDescr b
commaListFieldParsec String
"preferences"
forall a. Pretty a => a -> Doc
pretty forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
parsec
(ConfigExFlags -> [PackageVersionConstraint]
configPreferences forall b c a. (b -> c) -> (a -> b) -> a -> c
. SavedConfig -> ConfigExFlags
savedConfigureExFlags forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageEnvironment -> SavedConfig
pkgEnvSavedConfig)
(\[PackageVersionConstraint]
v PackageEnvironment
pkgEnv -> PackageEnvironment
-> (ConfigExFlags -> ConfigExFlags) -> PackageEnvironment
updateConfigureExFlags PackageEnvironment
pkgEnv
(\ConfigExFlags
flags -> ConfigExFlags
flags { configPreferences :: [PackageVersionConstraint]
configPreferences = [PackageVersionConstraint]
v }))
]
forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map FieldDescr SavedConfig -> FieldDescr PackageEnvironment
toPkgEnv [FieldDescr SavedConfig]
configFieldDescriptions'
where
configFieldDescriptions' :: [FieldDescr SavedConfig]
configFieldDescriptions' :: [FieldDescr SavedConfig]
configFieldDescriptions' = forall a. (a -> Bool) -> [a] -> [a]
filter
(\(FieldDescr String
name SavedConfig -> Doc
_ LineNo -> String -> SavedConfig -> ParseResult SavedConfig
_) -> String
name forall a. Eq a => a -> a -> Bool
/= String
"preference" Bool -> Bool -> Bool
&& String
name forall a. Eq a => a -> a -> Bool
/= String
"constraint")
(ConstraintSource -> [FieldDescr SavedConfig]
configFieldDescriptions ConstraintSource
src)
toPkgEnv :: FieldDescr SavedConfig -> FieldDescr PackageEnvironment
toPkgEnv :: FieldDescr SavedConfig -> FieldDescr PackageEnvironment
toPkgEnv FieldDescr SavedConfig
fieldDescr =
forall b a.
(b -> a) -> (a -> b -> b) -> FieldDescr a -> FieldDescr b
liftField PackageEnvironment -> SavedConfig
pkgEnvSavedConfig
(\SavedConfig
savedConfig PackageEnvironment
pkgEnv -> PackageEnvironment
pkgEnv { pkgEnvSavedConfig :: SavedConfig
pkgEnvSavedConfig = SavedConfig
savedConfig})
FieldDescr SavedConfig
fieldDescr
updateConfigureExFlags :: PackageEnvironment
-> (ConfigExFlags -> ConfigExFlags)
-> PackageEnvironment
updateConfigureExFlags :: PackageEnvironment
-> (ConfigExFlags -> ConfigExFlags) -> PackageEnvironment
updateConfigureExFlags PackageEnvironment
pkgEnv ConfigExFlags -> ConfigExFlags
f = PackageEnvironment
pkgEnv {
pkgEnvSavedConfig :: SavedConfig
pkgEnvSavedConfig = (PackageEnvironment -> SavedConfig
pkgEnvSavedConfig PackageEnvironment
pkgEnv) {
savedConfigureExFlags :: ConfigExFlags
savedConfigureExFlags = ConfigExFlags -> ConfigExFlags
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. SavedConfig -> ConfigExFlags
savedConfigureExFlags forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageEnvironment -> SavedConfig
pkgEnvSavedConfig
forall a b. (a -> b) -> a -> b
$ PackageEnvironment
pkgEnv
}
}
sortConstraints :: [(UserConstraint, b)] -> [(UserConstraint, b)]
sortConstraints = forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing forall a b. (a -> b) -> a -> b
$ UserConstraint -> PackageName
userConstraintPackageName forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst)
readPackageEnvironmentFile :: ConstraintSource -> PackageEnvironment -> FilePath
-> IO (Maybe (ParseResult PackageEnvironment))
readPackageEnvironmentFile :: ConstraintSource
-> PackageEnvironment
-> String
-> IO (Maybe (ParseResult PackageEnvironment))
readPackageEnvironmentFile ConstraintSource
src PackageEnvironment
initial String
file =
forall {a}. IO (Maybe a) -> IO (Maybe a)
handleNotExists forall a b. (a -> b) -> a -> b
$
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConstraintSource
-> PackageEnvironment
-> ByteString
-> ParseResult PackageEnvironment
parsePackageEnvironment ConstraintSource
src PackageEnvironment
initial) (String -> IO ByteString
BS.readFile String
file)
where
handleNotExists :: IO (Maybe a) -> IO (Maybe a)
handleNotExists IO (Maybe a)
action = forall a. IO a -> (IOException -> IO a) -> IO a
catchIO IO (Maybe a)
action forall a b. (a -> b) -> a -> b
$ \IOException
ioe ->
if IOException -> Bool
isDoesNotExistError IOException
ioe
then forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
else forall a. IOException -> IO a
ioError IOException
ioe
parsePackageEnvironment :: ConstraintSource -> PackageEnvironment -> BS.ByteString
-> ParseResult PackageEnvironment
parsePackageEnvironment :: ConstraintSource
-> PackageEnvironment
-> ByteString
-> ParseResult PackageEnvironment
parsePackageEnvironment ConstraintSource
src PackageEnvironment
initial ByteString
str = do
[Field]
fields <- ByteString -> ParseResult [Field]
readFields ByteString
str
let ([Field]
knownSections, [Field]
others) = forall a. (a -> Bool) -> [a] -> ([a], [a])
partition Field -> Bool
isKnownSection [Field]
fields
PackageEnvironment
pkgEnv <- [Field] -> ParseResult PackageEnvironment
parse [Field]
others
let config :: SavedConfig
config = PackageEnvironment -> SavedConfig
pkgEnvSavedConfig PackageEnvironment
pkgEnv
installDirs0 :: InstallDirs (Flag PathTemplate)
installDirs0 = SavedConfig -> InstallDirs (Flag PathTemplate)
savedUserInstallDirs SavedConfig
config
(HaddockFlags
haddockFlags, InstallDirs (Flag PathTemplate)
installDirs, [(String, String)]
paths, [(String, [String])]
args) <-
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (HaddockFlags, InstallDirs (Flag PathTemplate), [(String, String)],
[(String, [String])])
-> Field
-> ParseResult
(HaddockFlags, InstallDirs (Flag PathTemplate), [(String, String)],
[(String, [String])])
parseSections
(SavedConfig -> HaddockFlags
savedHaddockFlags SavedConfig
config, InstallDirs (Flag PathTemplate)
installDirs0, [], [])
[Field]
knownSections
forall (m :: * -> *) a. Monad m => a -> m a
return PackageEnvironment
pkgEnv {
pkgEnvSavedConfig :: SavedConfig
pkgEnvSavedConfig = SavedConfig
config {
savedConfigureFlags :: ConfigFlags
savedConfigureFlags = (SavedConfig -> ConfigFlags
savedConfigureFlags SavedConfig
config) {
configProgramPaths :: [(String, String)]
configProgramPaths = [(String, String)]
paths,
configProgramArgs :: [(String, [String])]
configProgramArgs = [(String, [String])]
args
},
savedHaddockFlags :: HaddockFlags
savedHaddockFlags = HaddockFlags
haddockFlags,
savedUserInstallDirs :: InstallDirs (Flag PathTemplate)
savedUserInstallDirs = InstallDirs (Flag PathTemplate)
installDirs,
savedGlobalInstallDirs :: InstallDirs (Flag PathTemplate)
savedGlobalInstallDirs = InstallDirs (Flag PathTemplate)
installDirs
}
}
where
isKnownSection :: ParseUtils.Field -> Bool
isKnownSection :: Field -> Bool
isKnownSection (ParseUtils.Section LineNo
_ String
"haddock" String
_ [Field]
_) = Bool
True
isKnownSection (ParseUtils.Section LineNo
_ String
"install-dirs" String
_ [Field]
_) = Bool
True
isKnownSection (ParseUtils.Section LineNo
_ String
"program-locations" String
_ [Field]
_) = Bool
True
isKnownSection (ParseUtils.Section LineNo
_ String
"program-default-options" String
_ [Field]
_) = Bool
True
isKnownSection Field
_ = Bool
False
parse :: [ParseUtils.Field] -> ParseResult PackageEnvironment
parse :: [Field] -> ParseResult PackageEnvironment
parse = forall a. [FieldDescr a] -> a -> [Field] -> ParseResult a
parseFields (ConstraintSource -> [FieldDescr PackageEnvironment]
pkgEnvFieldDescrs ConstraintSource
src) PackageEnvironment
initial
parseSections :: SectionsAccum -> ParseUtils.Field
-> ParseResult SectionsAccum
parseSections :: (HaddockFlags, InstallDirs (Flag PathTemplate), [(String, String)],
[(String, [String])])
-> Field
-> ParseResult
(HaddockFlags, InstallDirs (Flag PathTemplate), [(String, String)],
[(String, [String])])
parseSections accum :: (HaddockFlags, InstallDirs (Flag PathTemplate), [(String, String)],
[(String, [String])])
accum@(HaddockFlags
h,InstallDirs (Flag PathTemplate)
d,[(String, String)]
p,[(String, [String])]
a)
(ParseUtils.Section LineNo
_ String
"haddock" String
name [Field]
fs)
| String
name forall a. Eq a => a -> a -> Bool
== String
"" = do HaddockFlags
h' <- forall a. [FieldDescr a] -> a -> [Field] -> ParseResult a
parseFields [FieldDescr HaddockFlags]
haddockFlagsFields HaddockFlags
h [Field]
fs
forall (m :: * -> *) a. Monad m => a -> m a
return (HaddockFlags
h', InstallDirs (Flag PathTemplate)
d, [(String, String)]
p, [(String, [String])]
a)
| Bool
otherwise = do
String -> ParseResult ()
warning String
"The 'haddock' section should be unnamed"
forall (m :: * -> *) a. Monad m => a -> m a
return (HaddockFlags, InstallDirs (Flag PathTemplate), [(String, String)],
[(String, [String])])
accum
parseSections (HaddockFlags
h,InstallDirs (Flag PathTemplate)
d,[(String, String)]
p,[(String, [String])]
a)
(ParseUtils.Section LineNo
line String
"install-dirs" String
name [Field]
fs)
| String
name forall a. Eq a => a -> a -> Bool
== String
"" = do InstallDirs (Flag PathTemplate)
d' <- forall a. [FieldDescr a] -> a -> [Field] -> ParseResult a
parseFields [FieldDescr (InstallDirs (Flag PathTemplate))]
installDirsFields InstallDirs (Flag PathTemplate)
d [Field]
fs
forall (m :: * -> *) a. Monad m => a -> m a
return (HaddockFlags
h, InstallDirs (Flag PathTemplate)
d',[(String, String)]
p,[(String, [String])]
a)
| Bool
otherwise =
forall a. LineNo -> String -> ParseResult a
syntaxError LineNo
line forall a b. (a -> b) -> a -> b
$
String
"Named 'install-dirs' section: '" forall a. [a] -> [a] -> [a]
++ String
name
forall a. [a] -> [a] -> [a]
++ String
"'. Note that named 'install-dirs' sections are not allowed in the '"
forall a. [a] -> [a] -> [a]
++ String
userPackageEnvironmentFile forall a. [a] -> [a] -> [a]
++ String
"' file."
parseSections accum :: (HaddockFlags, InstallDirs (Flag PathTemplate), [(String, String)],
[(String, [String])])
accum@(HaddockFlags
h, InstallDirs (Flag PathTemplate)
d,[(String, String)]
p,[(String, [String])]
a)
(ParseUtils.Section LineNo
_ String
"program-locations" String
name [Field]
fs)
| String
name forall a. Eq a => a -> a -> Bool
== String
"" = do [(String, String)]
p' <- forall a. [FieldDescr a] -> a -> [Field] -> ParseResult a
parseFields [FieldDescr [(String, String)]]
withProgramsFields [(String, String)]
p [Field]
fs
forall (m :: * -> *) a. Monad m => a -> m a
return (HaddockFlags
h, InstallDirs (Flag PathTemplate)
d, [(String, String)]
p', [(String, [String])]
a)
| Bool
otherwise = do
String -> ParseResult ()
warning String
"The 'program-locations' section should be unnamed"
forall (m :: * -> *) a. Monad m => a -> m a
return (HaddockFlags, InstallDirs (Flag PathTemplate), [(String, String)],
[(String, [String])])
accum
parseSections accum :: (HaddockFlags, InstallDirs (Flag PathTemplate), [(String, String)],
[(String, [String])])
accum@(HaddockFlags
h, InstallDirs (Flag PathTemplate)
d, [(String, String)]
p, [(String, [String])]
a)
(ParseUtils.Section LineNo
_ String
"program-default-options" String
name [Field]
fs)
| String
name forall a. Eq a => a -> a -> Bool
== String
"" = do [(String, [String])]
a' <- forall a. [FieldDescr a] -> a -> [Field] -> ParseResult a
parseFields [FieldDescr [(String, [String])]]
withProgramOptionsFields [(String, [String])]
a [Field]
fs
forall (m :: * -> *) a. Monad m => a -> m a
return (HaddockFlags
h, InstallDirs (Flag PathTemplate)
d, [(String, String)]
p, [(String, [String])]
a')
| Bool
otherwise = do
String -> ParseResult ()
warning String
"The 'program-default-options' section should be unnamed"
forall (m :: * -> *) a. Monad m => a -> m a
return (HaddockFlags, InstallDirs (Flag PathTemplate), [(String, String)],
[(String, [String])])
accum
parseSections (HaddockFlags, InstallDirs (Flag PathTemplate), [(String, String)],
[(String, [String])])
accum Field
f = do
String -> ParseResult ()
warning forall a b. (a -> b) -> a -> b
$ String
"Unrecognized stanza on line " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (Field -> LineNo
lineNo Field
f)
forall (m :: * -> *) a. Monad m => a -> m a
return (HaddockFlags, InstallDirs (Flag PathTemplate), [(String, String)],
[(String, [String])])
accum
type SectionsAccum = (HaddockFlags, InstallDirs (Flag PathTemplate)
, [(String, FilePath)], [(String, [String])])
showPackageEnvironment :: PackageEnvironment -> String
showPackageEnvironment :: PackageEnvironment -> String
showPackageEnvironment PackageEnvironment
pkgEnv = Maybe PackageEnvironment -> PackageEnvironment -> String
showPackageEnvironmentWithComments forall a. Maybe a
Nothing PackageEnvironment
pkgEnv
showPackageEnvironmentWithComments :: (Maybe PackageEnvironment)
-> PackageEnvironment
-> String
Maybe PackageEnvironment
mdefPkgEnv PackageEnvironment
pkgEnv = Doc -> String
Disp.render forall a b. (a -> b) -> a -> b
$
forall a. [FieldDescr a] -> Maybe a -> a -> Doc
ppFields (ConstraintSource -> [FieldDescr PackageEnvironment]
pkgEnvFieldDescrs ConstraintSource
ConstraintSourceUnknown)
Maybe PackageEnvironment
mdefPkgEnv PackageEnvironment
pkgEnv
Doc -> Doc -> Doc
$+$ String -> Doc
Disp.text String
""
Doc -> Doc -> Doc
$+$ forall a. String -> String -> [FieldDescr a] -> Maybe a -> a -> Doc
ppSection String
"install-dirs" String
"" [FieldDescr (InstallDirs (Flag PathTemplate))]
installDirsFields
(forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PackageEnvironment -> InstallDirs (Flag PathTemplate)
installDirsSection Maybe PackageEnvironment
mdefPkgEnv) (PackageEnvironment -> InstallDirs (Flag PathTemplate)
installDirsSection PackageEnvironment
pkgEnv)
where
installDirsSection :: PackageEnvironment -> InstallDirs (Flag PathTemplate)
installDirsSection = SavedConfig -> InstallDirs (Flag PathTemplate)
savedUserInstallDirs forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageEnvironment -> SavedConfig
pkgEnvSavedConfig