import Data.Maybe ( isNothing )
import System.Directory ( doesFileExist )
import Control.Monad ( foldM )
-import Data.List ( nub, partition )
+import Data.List ( nub, partition, sortBy )
#ifdef mingw32_TARGET_OS
import Data.List ( isPrefixOf )
procflags pkgs expl [] = return (pkgs,expl)
procflags pkgs expl (ExposePackage str : flags) = do
- case partition (matches str) pkgs of
- ([],_) -> missingPackageErr str
- ([p],ps) -> procflags (p':ps') expl' flags
+ case pick str pkgs of
+ Nothing -> missingPackageErr str
+ Just (p,ps) -> procflags (p':ps') expl' flags
where pkgid = packageConfigId p
p' = p {exposed=True}
ps' = hideAll (pkgName (package p)) ps
expl' = addOneToUniqSet expl pkgid
- (ps,_) -> multiplePackagesErr str ps
procflags pkgs expl (HidePackage str : flags) = do
case partition (matches str) pkgs of
([],_) -> missingPackageErr str
- ([p],ps) -> procflags (p':ps) expl flags
- where p' = p {exposed=False}
- (ps,_) -> multiplePackagesErr str ps
+ (ps,qs) -> procflags (map hide ps ++ qs) expl flags
+ where hide p = p {exposed=False}
procflags pkgs expl (IgnorePackage str : flags) = do
case partition (matches str) pkgs of
(ps,qs) -> procflags qs expl flags
-- because a common usage is to -ignore-package P as
-- a preventative measure just in case P exists.
+ pick str pkgs
+ = case partition (matches str) pkgs of
+ ([],_) -> Nothing
+ (ps,rest) ->
+ case sortBy (flip (comparing (pkgVersion.package))) ps of
+ (p:ps) -> Just (p, ps ++ rest)
+ _ -> panic "Packages.pick"
+
+ comparing f a b = f a `compare` f b
+
-- A package named on the command line can either include the
-- version, or just the name if it is unambiguous.
matches str p
thPackageName = FSLIT("template-haskell")
-- Template Haskell libraries in here
-multiplePackagesErr str ps =
- throwDyn (CmdLineError (showSDoc (
- text "Error; multiple packages match" <+>
- text str <> colon <+>
- sep (punctuate comma (map (text.showPackageId.package) ps))
- )))
-
mkModuleMap
:: PackageConfigMap
-> [PackageId]