hackport 0.2.16 → 0.2.17
raw patch · 13 files changed
+340/−242 lines, 13 files
Files
- Cabal2Ebuild.hs +18/−16
- Hackage.hs +32/−0
- Main.hs +13/−35
- Merge.hs +6/−3
- Merge/Dependencies.hs +55/−41
- Portage/Dependency.hs +75/−48
- Portage/Host.hs +4/−6
- Portage/Resolve.hs +5/−2
- Portage/Use.hs +50/−0
- Status.hs +76/−10
- hackport.cabal +3/−2
- tests/resolveCat.hs +3/−1
- unused/Fetch.hs +0/−78
Cabal2Ebuild.hs view
@@ -37,9 +37,12 @@ import Data.Char (toLower,isUpper) import Portage.Dependency+import Portage.Use import qualified Portage.PackageId as Portage import qualified Portage.EBuild as Portage+import qualified Portage.Resolve as Portage import qualified Portage.EBuild as E+import qualified Portage.Overlay as O import Portage.Version cabal2ebuild :: Cabal.PackageDescription -> Portage.EBuild@@ -66,27 +69,27 @@ then E.homepage E.ebuildTemplate else Cabal.homepage pkg -convertDependencies :: Portage.Category -> [Cabal.Dependency] -> [Dependency]-convertDependencies category = concatMap (convertDependency category)+convertDependencies :: O.Overlay -> Portage.Category -> [Cabal.Dependency] -> [Dependency]+convertDependencies overlay category = concatMap (convertDependency overlay category) -convertDependency :: Portage.Category -> Cabal.Dependency -> [Dependency]-convertDependency _category (Cabal.Dependency pname@(Cabal.PackageName _name) _)+convertDependency :: O.Overlay -> Portage.Category -> Cabal.Dependency -> [Dependency]+convertDependency overlay _category (Cabal.Dependency pname@(Cabal.PackageName _name) _) | pname `elem` coreLibs = [] -- no explicit dep on core libs-convertDependency category (Cabal.Dependency pname versionRange)+convertDependency overlay category (Cabal.Dependency pname versionRange) = convert versionRange where- -- XXX: not always true, we should look properly for deps in the overlay- -- to find the correct category- pn = Portage.PackageName category (Portage.normalizeCabalPackageName pname)+ pn = case Portage.resolveFullPortageName overlay pname of+ Just r -> r+ Nothing -> Portage.PackageName category (Portage.normalizeCabalPackageName pname) convert :: Cabal.VersionRange -> [Dependency] convert = Cabal.foldVersionRange'- ( [AnyVersionOf pn] -- ^ @\"-any\"@ version- )(\v -> [ThisVersionOf (fromCabalVersion v) pn] -- ^ @\"== v\"@- )(\v -> [LaterVersionOf (fromCabalVersion v) pn] -- ^ @\"> v\"@- )(\v -> [EarlierVersionOf (fromCabalVersion v) pn] -- ^ @\"< v\"@- )(\v -> [OrLaterVersionOf (fromCabalVersion v) pn] -- ^ @\">= v\"@- )(\v -> [OrEarlierVersionOf (fromCabalVersion v) pn] -- ^ @\"<= v\"@- )(\v _ -> [ThisMajorOf (fromCabalVersion v) pn] -- ^ @\"== v.*\"@ wildcard. (incl lower, excl upper)+ ( [AnyVersionOf pn []] -- ^ @\"-any\"@ version+ )(\v -> [ThisVersionOf (fromCabalVersion v) pn []] -- ^ @\"== v\"@+ )(\v -> [LaterVersionOf (fromCabalVersion v) pn []] -- ^ @\"> v\"@+ )(\v -> [EarlierVersionOf (fromCabalVersion v) pn []] -- ^ @\"< v\"@+ )(\v -> [OrLaterVersionOf (fromCabalVersion v) pn []] -- ^ @\">= v\"@+ )(\v -> [OrEarlierVersionOf (fromCabalVersion v) pn []] -- ^ @\"<= v\"@+ )(\v _ -> [ThisMajorOf (fromCabalVersion v) pn []] -- ^ @\"== v.*\"@ wildcard. (incl lower, excl upper) )(\g1 g2 -> [DependEither (flatten g1 ++ flatten g2) ] -- ^ @\"_ || _\"@ union )(\r1 r2 -> r1 ++ r2 -- ^ @\"_ && _\"@ intersection )(\dp -> [AllOf dp ] -- ^ @\"(_)\"@ parentheses@@ -95,7 +98,6 @@ flatten :: [Dependency] -> [[Dependency]] flatten [DependEither ds] = concatMap flatten ds flatten other = [other]- coreLibs :: [Cabal.PackageName] coreLibs = map Cabal.PackageName
+ Hackage.hs view
@@ -0,0 +1,32 @@+{-|+ Author : Sergei Trofimovich <slyfox@gentoo.org>+ Stability : experimental+ Portability : haskell98++ Utilities to work with hackage-alike repositories+-}+module Hackage+ ( defaultRepo+ , defaultRepoURI+ ) where++import Distribution.Client.Types (Repo(..), RemoteRepo(..))+import Network.URI (URI(..), URIAuth(..))+import System.FilePath++defaultRepo :: FilePath -> Repo+defaultRepo overlayPath =+ Repo {+ repoKind = Left hackage,+ repoLocalDir = overlayPath </> ".hackport"+ }+ where+ hackage = RemoteRepo server_name uri+ server_name = "hackage.haskell.org"+ uri = URI "http:" (Just (URIAuth "" server_name "")) "/packages/archive" "" ""++defaultRepoURI :: FilePath -> URI+defaultRepoURI overlayPath =+ case repoKind (defaultRepo overlayPath) of+ Left (RemoteRepo { remoteRepoURI = uri }) -> uri+ Right _ -> error $ "defaultRepoURI: unable to get URI for " ++ overlayPath
Main.hs view
@@ -28,11 +28,13 @@ import qualified Distribution.Client.PackageIndex as Index import qualified Distribution.Client.IndexUtils as Index +import Hackage (defaultRepo, defaultRepoURI)+ import Portage.Overlay as Overlay ( loadLazy, inOverlay ) import Portage.Host as Host ( getInfo, portage_dir ) import Portage.PackageId ( normalizeCabalPackageId ) -import Network.URI ( URI(..), URIAuth(..), parseURI )+import Network.URI ( URI(..), parseURI ) import System.Environment ( getArgs, getProgName ) import System.Directory ( doesDirectoryExist ) import System.Exit ( exitFailure )@@ -295,24 +297,13 @@ data StatusFlags = StatusFlags { statusVerbosity :: Flag Verbosity,- statusToPortage :: Flag Bool+ statusDirection :: Flag StatusDirection } -instance Monoid StatusFlags where- mempty = StatusFlags {- statusVerbosity = mempty,- statusToPortage = mempty- }- mappend a b = StatusFlags {- statusVerbosity = combine statusVerbosity,- statusToPortage = combine statusToPortage- }- where combine field = field a `mappend` field b- defaultStatusFlags :: StatusFlags defaultStatusFlags = StatusFlags { statusVerbosity = Flag normal,- statusToPortage = Flag False+ statusDirection = Flag PortagePlusOverlay } statusCommand :: CommandUI StatusFlags@@ -327,18 +318,22 @@ [ optionVerbosity statusVerbosity (\v flags -> flags { statusVerbosity = v }) , option [] ["to-portage"] "Print only packages likely to be interesting to move to the portage tree."- statusToPortage (\v flags -> flags { statusToPortage = v })- trueArg+ statusDirection (\v flags -> flags { statusDirection = v })+ (noArg (Flag OverlayToPortage))+ , option [] ["from-hackage"]+ "Print only packages likely to be interesting to move from hackage tree."+ statusDirection (\v flags -> flags { statusDirection = v })+ (noArg (Flag HackageToOverlay)) ] } statusAction :: StatusFlags -> [String] -> GlobalFlags -> IO () statusAction flags args globalFlags = do let verbosity = fromFlag (statusVerbosity flags)- toPortdir = fromFlag (statusToPortage flags)+ direction = fromFlag (statusDirection flags) portagePath <- getPortageDir verbosity globalFlags overlayPath <- getOverlayPath verbosity (fromFlag $ globalPathToOverlay globalFlags)- runStatus verbosity portagePath overlayPath toPortdir args+ runStatus verbosity portagePath overlayPath direction args ----------------------------------------------------------------------- -- Merge@@ -440,23 +435,6 @@ ----------------------------------------------------------------------- -- Utils -------------------------------------------------------------------------defaultRepo :: FilePath -> Repo-defaultRepo overlayPath =- Repo {- repoKind = Left hackage,- repoLocalDir = overlayPath </> ".hackport"- }- where- hackage = RemoteRepo server_name uri- server_name = "hackage.haskell.org"- uri = URI "http:" (Just (URIAuth "" server_name "")) "/packages/archive" "" ""--defaultRepoURI :: FilePath -> URI-defaultRepoURI overlayPath =- case repoKind (defaultRepo overlayPath) of- Left (RemoteRepo { remoteRepoURI = uri }) -> uri- Right _ -> error $ "defaultRepoURI: unable to get URI for " ++ overlayPath getServerURI :: String -> IO URI getServerURI str =
Merge.hs view
@@ -7,7 +7,7 @@ import Control.Monad.Error import Control.Exception import Data.Maybe-import Data.List+import Data.List as L import Distribution.Package import Distribution.PackageDescription ( PackageDescription(..) , FlagName(..)@@ -123,7 +123,9 @@ case map snd (Index.searchByName index user_pname_str) of [] -> throwEx (PackageNotFound user_pname_str) [pkg] -> return pkg- pkgs -> throwEx (ArgumentError ("Ambiguous name: " ++ unwords (map show pkgs)))+ pkgs -> let names = map (pkgName . packageInfoId . L.head) pkgs+ whole_list = map (L.intercalate "\n" . map (show . packageInfoId)) pkgs+ in throwEx $ ArgumentError $ L.intercalate "\n---\n" $ ["Ambiguous names: " ++ show names] ++ whole_list -- select a single package taking into account the user specified version selectedPkg <-@@ -149,6 +151,7 @@ mergeGenericPackageDescription :: Verbosity -> FilePath -> Portage.Category -> GenericPackageDescription -> Bool -> IO () mergeGenericPackageDescription verbosity overlayPath cat pkgGenericDesc fetch = do+ overlay <- Overlay.loadLazy overlayPath let Right (pkgDesc0, flags) = finalizePackageDescription [ -- XXX: common things we should enable/disable?@@ -169,7 +172,7 @@ , pn `notElem` excludePkgs ] in pkgDesc0 { buildDepends = deps }- edeps = Merge.resolveDependencies pkgDesc (Just compilerId)+ edeps = Merge.resolveDependencies overlay pkgDesc (Just compilerId) debug verbosity ("Selected flags: " ++ show flags) info verbosity ("Guessing GHC version: " ++ maybe "could not guess" (display.fst) mminimumGHC)
Merge/Dependencies.hs view
@@ -63,9 +63,11 @@ import qualified Distribution.Version as Cabal import Distribution.Compiler -import qualified Portage.Version as Portage-import qualified Portage.PackageId as Portage import qualified Portage.Dependency as Portage+import qualified Portage.Overlay as Portage+import qualified Portage.PackageId as Portage+import qualified Portage.Use as Portage+import qualified Portage.Version as Portage import qualified Cabal2Ebuild as C2E import qualified Portage.GHCCore as GHCCore@@ -90,8 +92,8 @@ dep_e = [] } -resolveDependencies :: PackageDescription -> Maybe CompilerId -> EDep-resolveDependencies pkg mcompiler =+resolveDependencies :: Portage.Overlay -> PackageDescription -> Maybe CompilerId -> EDep+resolveDependencies overlay pkg mcompiler = edeps { dep = Portage.simplify_deps ( dep edeps),@@ -104,12 +106,14 @@ hasBuildableExes p = any (buildable . buildInfo) . executables $ p treatAsLibrary = (not . hasBuildableExes) pkg || hasLibs pkg- haskell_deps = haskellDependencies pkg- cabal_dep = cabalDependency pkg compiler+ haskell_deps+ | treatAsLibrary = add_profile $ haskellDependencies overlay pkg+ | otherwise = haskellDependencies overlay pkg+ cabal_dep = cabalDependency overlay pkg compiler ghc_dep = compilerIdToDependency compiler extra_libs = findCLibs pkg build_tools = buildToolsDependencies pkg- pkg_config = pkgConfigDependencies pkg+ pkg_config = pkgConfigDependencies overlay pkg edeps | treatAsLibrary = emptyEDep {@@ -130,16 +134,17 @@ dep_e = [ "${RDEPEND}" ], rdep = extra_libs ++ pkg_config }+ add_profile = map (flip Portage.addDepUseFlag (Portage.mkQUse "profile")) --------------------------------------------------------------- -- Haskell packages --------------------------------------------------------------- -haskellDependencies :: PackageDescription -> [Portage.Dependency]-haskellDependencies pkg =- Portage.simplify_deps- $ C2E.convertDependencies (Portage.Category "dev-haskell") (buildDepends pkg)+haskellDependencies :: Portage.Overlay -> PackageDescription -> [Portage.Dependency]+haskellDependencies overlay pkg =+ Portage.simplify_deps+ $ C2E.convertDependencies overlay (Portage.Category "dev-haskell") (buildDepends pkg) --------------------------------------------------------------- -- Cabal Dependency@@ -147,9 +152,10 @@ -- | Select the most restrictive dependency on Cabal, either the .cabal -- file's descCabalVersion, or the Cabal GHC shipped with.-cabalDependency :: PackageDescription -> CompilerId -> Portage.Dependency-cabalDependency pkg (CompilerId GHC ghcVersion@(Cabal.Version versionNumbers _)) =- head $ C2E.convertDependency (Portage.Category "dev-haskell")+cabalDependency :: Portage.Overlay -> PackageDescription -> CompilerId -> Portage.Dependency+cabalDependency overlay pkg (CompilerId GHC ghcVersion@(Cabal.Version versionNumbers _)) =+ head $ C2E.convertDependency overlay+ (Portage.Category "dev-haskell") (Cabal.Dependency (Cabal.PackageName "Cabal") finalCabalDep) where@@ -171,7 +177,7 @@ compilerIdToDependency :: CompilerId -> Portage.Dependency compilerIdToDependency (CompilerId GHC versionNumbers) =- Portage.OrLaterVersionOf (Portage.fromCabalVersion versionNumbers) (Portage.mkPackageName "dev-lang" "ghc")+ Portage.OrLaterVersionOf (Portage.fromCabalVersion versionNumbers) (Portage.mkPackageName "dev-lang" "ghc") [] --------------------------------------------------------------- -- C Libraries@@ -180,7 +186,7 @@ findCLibs :: PackageDescription -> [Portage.Dependency] findCLibs (PackageDescription { library = lib, executables = exes }) = [ trace ("WARNING: This package depends on a C library we don't know the portage name for: " ++ p ++ ". Check the generated ebuild.")- (Portage.AnyVersionOf (Portage.mkPackageName "unknown-c-lib" p))+ (Portage.AnyVersionOf (Portage.mkPackageName "unknown-c-lib" p) []) | p <- notFound ] ++ found@@ -195,14 +201,15 @@ staticTranslateExtraLib :: String -> Maybe Portage.Dependency staticTranslateExtraLib lib = lookup lib m where- m = [ ("z", Portage.AnyVersionOf (Portage.mkPackageName "sys-libs" "zlib"))- , ("bz2", Portage.AnyVersionOf (Portage.mkPackageName "sys-libs" "bzlib"))- , ("mysqlclient", Portage.LaterVersionOf (Portage.Version [4,0] Nothing [] 0) (Portage.mkPackageName "virtual" "mysql"))- , ("pq", Portage.LaterVersionOf (Portage.Version [7] Nothing [] 0) (Portage.mkPackageName "virtual" "postgresql-base"))- , ("ev", Portage.AnyVersionOf (Portage.mkPackageName "dev-libs" "libev"))- , ("expat", Portage.AnyVersionOf (Portage.mkPackageName "dev-libs" "expat"))- , ("curl", Portage.AnyVersionOf (Portage.mkPackageName "net-misc" "curl"))- , ("xml2", Portage.AnyVersionOf (Portage.mkPackageName "dev-libs" "libxml2"))+ m = [ ("z", Portage.AnyVersionOf (Portage.mkPackageName "sys-libs" "zlib") [])+ , ("bz2", Portage.AnyVersionOf (Portage.mkPackageName "sys-libs" "bzlib") [])+ , ("mysqlclient", Portage.LaterVersionOf (Portage.Version [4,0] Nothing [] 0) (Portage.mkPackageName "virtual" "mysql") [])+ , ("pq", Portage.LaterVersionOf (Portage.Version [7] Nothing [] 0) (Portage.mkPackageName "virtual" "postgresql-base") [])+ , ("ev", Portage.AnyVersionOf (Portage.mkPackageName "dev-libs" "libev") [])+ , ("expat", Portage.AnyVersionOf (Portage.mkPackageName "dev-libs" "expat") [])+ , ("curl", Portage.AnyVersionOf (Portage.mkPackageName "net-misc" "curl") [])+ , ("xml2", Portage.AnyVersionOf (Portage.mkPackageName "dev-libs" "libxml2") [])+ , ("mecab", Portage.AnyVersionOf (Portage.mkPackageName "app-text" "mecab") []) ] ---------------------------------------------------------------@@ -214,48 +221,55 @@ [ case pkg of Just p -> p Nothing -> trace ("WARNING: Unknown build tool '" ++ pn ++ "'. Check the generated ebuild.")- (Portage.AnyVersionOf (Portage.mkPackageName "unknown-build-tool" pn))+ (Portage.AnyVersionOf (Portage.mkPackageName "unknown-build-tool" pn) []) | Cabal.Dependency (Cabal.PackageName pn) _range <- cabalDeps , pkg <- return (lookup pn buildToolsTable) ] where- cabalDeps = depL ++ depE+ cabalDeps = filter notProvided $ depL ++ depE depL = maybe [] (buildTools.libBuildInfo) lib depE = concatMap buildTools (filter buildable (map buildInfo exes))+ notProvided (Cabal.Dependency (Cabal.PackageName pn) _range) = pn `notElem` buildToolsProvided buildToolsTable :: [(String, Portage.Dependency)] buildToolsTable =- [ ("happy", Portage.AnyVersionOf (Portage.mkPackageName "dev-haskell" "happy"))- , ("alex", Portage.AnyVersionOf (Portage.mkPackageName "dev-haskell" "alex"))- , ("c2hs", Portage.AnyVersionOf (Portage.mkPackageName "dev-haskell" "c2hs"))- , ("gtk2hsTypeGen", Portage.AnyVersionOf (Portage.mkPackageName "dev-haskell" "gtk2hs-buildtools"))- , ("gtk2hsHookGenerator", Portage.AnyVersionOf (Portage.mkPackageName "dev-haskell" "gtk2hs-buildtools"))- , ("gtk2hsC2hs", Portage.AnyVersionOf (Portage.mkPackageName "dev-haskell" "gtk2hs-buildtools"))+ [ ("happy", Portage.AnyVersionOf (Portage.mkPackageName "dev-haskell" "happy") [])+ , ("alex", Portage.AnyVersionOf (Portage.mkPackageName "dev-haskell" "alex") [])+ , ("c2hs", Portage.AnyVersionOf (Portage.mkPackageName "dev-haskell" "c2hs") [])+ , ("gtk2hsTypeGen", Portage.AnyVersionOf (Portage.mkPackageName "dev-haskell" "gtk2hs-buildtools") [])+ , ("gtk2hsHookGenerator", Portage.AnyVersionOf (Portage.mkPackageName "dev-haskell" "gtk2hs-buildtools") [])+ , ("gtk2hsC2hs", Portage.AnyVersionOf (Portage.mkPackageName "dev-haskell" "gtk2hs-buildtools") []) ] +-- tools that are provided by ghc or some other existing program+-- so we do not need dependencies on them+buildToolsProvided :: [String]+buildToolsProvided = ["hsc2hs"]++ --------------------------------------------------------------- -- pkg-config --------------------------------------------------------------- -pkgConfigDependencies :: PackageDescription -> [Portage.Dependency]-pkgConfigDependencies (PackageDescription { library = lib, executables = exes }) = nub $ resolvePkgConfigs cabalDeps+pkgConfigDependencies :: Portage.Overlay -> PackageDescription -> [Portage.Dependency]+pkgConfigDependencies overlay (PackageDescription { library = lib, executables = exes }) = nub $ resolvePkgConfigs overlay cabalDeps where cabalDeps = depL ++ depE depL = maybe [] (pkgconfigDepends.libBuildInfo) lib depE = concatMap pkgconfigDepends (filter buildable (map buildInfo exes)) -resolvePkgConfigs :: [Cabal.Dependency] -> [Portage.Dependency]-resolvePkgConfigs cdeps =- [ case resolvePkgConfig pkg of+resolvePkgConfigs :: Portage.Overlay -> [Cabal.Dependency] -> [Portage.Dependency]+resolvePkgConfigs overlay cdeps =+ [ case resolvePkgConfig overlay pkg of Just d -> d Nothing -> trace ("WARNING: Could not resolve pkg-config: " ++ pn ++ ". Check generated ebuild.")- (Portage.AnyVersionOf (Portage.mkPackageName "unknown-pkg-config" pn))+ (Portage.AnyVersionOf (Portage.mkPackageName "unknown-pkg-config" pn) []) | pkg@(Cabal.Dependency (Cabal.PackageName pn) _range) <- cdeps ] -resolvePkgConfig :: Cabal.Dependency -> Maybe Portage.Dependency-resolvePkgConfig (Cabal.Dependency (Cabal.PackageName pn) _cabalVersion) = do+resolvePkgConfig :: Portage.Overlay -> Cabal.Dependency -> Maybe Portage.Dependency+resolvePkgConfig overlay (Cabal.Dependency (Cabal.PackageName pn) _cabalVersion) = do (cat,portname) <- lookup pn table- return . head $ (C2E.convertDependency (Portage.Category cat) (Cabal.Dependency (Cabal.PackageName portname) _cabalVersion))+ return . head $ (C2E.convertDependency overlay (Portage.Category cat) (Cabal.Dependency (Cabal.PackageName portname) _cabalVersion)) table :: [(String, (String, String))] table =
Portage/Dependency.hs view
@@ -1,9 +1,11 @@ module Portage.Dependency ( Dependency(..),- simplify_deps+ simplify_deps,+ addDepUseFlag ) where import Portage.Version+import Portage.Use import Distribution.Text ( display, Text(..) ) import Portage.PackageId@@ -15,17 +17,15 @@ import Data.List ( nub, groupBy, partition, sortBy ) import Data.Ord (comparing) -type UseFlag = String--data Dependency = AnyVersionOf PackageName- | ThisVersionOf Version PackageName -- ~package-version- | LaterVersionOf Version PackageName -- >package-version- | EarlierVersionOf Version PackageName -- <package-version- | OrLaterVersionOf Version PackageName -- >=package-version- | OrEarlierVersionOf Version PackageName -- <=package-version- | DependEither [[Dependency]] -- || ( depend_group1 ..depend_groupN )+data Dependency = AnyVersionOf PackageName [UseFlag]+ | ThisVersionOf Version PackageName [UseFlag] -- ~package-version+ | LaterVersionOf Version PackageName [UseFlag] -- >package-version+ | EarlierVersionOf Version PackageName [UseFlag] -- <package-version+ | OrLaterVersionOf Version PackageName [UseFlag] -- >=package-version+ | OrEarlierVersionOf Version PackageName [UseFlag] -- <=package-version+ | DependEither [[Dependency]] -- || ( depend_group1 ..depend_groupN ) | DependIfUse UseFlag Dependency -- use? ( depend )- | ThisMajorOf Version PackageName -- =package-version*+ | ThisMajorOf Version PackageName [UseFlag] -- =package-version* | AllOf [Dependency] -- ( package-version* ) deriving (Eq,Show) @@ -36,26 +36,27 @@ a <-> b = a <> Disp.char '-' <> b showDepend :: Dependency -> Disp.Doc-showDepend (AnyVersionOf p) = disp p-showDepend (ThisVersionOf v p) = Disp.char '~' <> disp p <-> disp v { versionRevision = 0 }-showDepend (LaterVersionOf v p) = Disp.char '>' <> disp p <-> disp v-showDepend (EarlierVersionOf v p) = Disp.char '<' <> disp p <-> disp v-showDepend (OrLaterVersionOf v p) = Disp.text ">=" <> disp p <-> disp v-showDepend (OrEarlierVersionOf v p) = Disp.text "<=" <> disp p <-> disp v+showDepend (AnyVersionOf p u) = disp p <> dispUses u +showDepend (ThisVersionOf v p u) = Disp.char '~' <> disp p <-> disp v { versionRevision = 0 }<>dispUses u+showDepend (LaterVersionOf v p u) = Disp.char '>' <> disp p <-> disp v <> dispUses u+showDepend (EarlierVersionOf v p u) = Disp.char '<' <> disp p <-> disp v <> dispUses u+showDepend (OrLaterVersionOf v p u) = Disp.text ">=" <> disp p <-> disp v <> dispUses u+showDepend (OrEarlierVersionOf v p u) = Disp.text "<=" <> disp p <-> disp v <> dispUses u showDepend (DependEither dep_groups0) = Disp.text "|| " <> spaceParens dep_groups where dep_groups = map (spaceParens . map disp) dep_groups0 spaceParens ds = Disp.parens (Disp.space <> Disp.hsep ds <> Disp.space) showDepend (DependIfUse useflag dep@(DependEither _))- = Disp.text useflag <> Disp.text "? " <> disp dep+ = disp useflag <> Disp.text "? " <> disp dep showDepend (DependIfUse useflag dep)- = Disp.text useflag <> Disp.text "? " <> Disp.parens (disp dep)-showDepend (ThisMajorOf v p) = Disp.char '=' <> disp p <-> disp v <> Disp.char '*'+ = disp useflag <> Disp.text "? " <> Disp.parens (disp dep)+showDepend (ThisMajorOf v p u) = Disp.char '=' <> disp p <-> disp v <> Disp.char '*' <> dispUses u showDepend (AllOf dp ) = Disp.text "( " <> hsep (map showDepend dp) <> Disp.text " )" {- Here goes code for dependencies simplification -} simplify_group_table :: PackageName ->+ [UseFlag] -> Maybe Version -> Maybe Version -> Maybe Version ->@@ -64,26 +65,26 @@ -- simplify_group_table p ol l e oe exact -- 1) trivial cases:-simplify_group_table p Nothing Nothing Nothing Nothing Nothing = error $ display p ++ ": unsolvable constraints"-simplify_group_table p (Just v) Nothing Nothing Nothing Nothing = [OrLaterVersionOf v p]-simplify_group_table p Nothing (Just v) Nothing Nothing Nothing = [LaterVersionOf v p]-simplify_group_table p Nothing Nothing (Just v) Nothing Nothing = [EarlierVersionOf v p]-simplify_group_table p Nothing Nothing Nothing (Just v) Nothing = [OrEarlierVersionOf v p]-simplify_group_table p Nothing Nothing Nothing Nothing (Just v) = [ThisVersionOf v p]+simplify_group_table p u Nothing Nothing Nothing Nothing Nothing = error $ display p ++ ": unsolvable constraints"+simplify_group_table p u (Just v) Nothing Nothing Nothing Nothing = [OrLaterVersionOf v p u]+simplify_group_table p u Nothing (Just v) Nothing Nothing Nothing = [LaterVersionOf v p u]+simplify_group_table p u Nothing Nothing (Just v) Nothing Nothing = [EarlierVersionOf v p u]+simplify_group_table p u Nothing Nothing Nothing (Just v) Nothing = [OrEarlierVersionOf v p u]+simplify_group_table p u Nothing Nothing Nothing Nothing (Just v) = [ThisVersionOf v p u] -- 2) simplification passes-simplify_group_table p (Just (Version v1 _ _ _)) Nothing (Just (Version v2 _ _ _)) Nothing Nothing+simplify_group_table p u (Just (Version v1 _ _ _)) Nothing (Just (Version v2 _ _ _)) Nothing Nothing -- special case: >=a-v.N a<v.(N+1) => =a-v.N*- | (init v1 == init v2) && (last v2 == last v1 + 1) = [ThisMajorOf (Version v1 Nothing [] 0) p]- | otherwise = [OrLaterVersionOf (Version v1 Nothing [] 0) p, EarlierVersionOf (Version v2 Nothing [] 0) p]+ | (init v1 == init v2) && (last v2 == last v1 + 1) = [ThisMajorOf (Version v1 Nothing [] 0) p u]+ | otherwise = [OrLaterVersionOf (Version v1 Nothing [] 0) p u, EarlierVersionOf (Version v2 Nothing [] 0) p u] -- TODO: simplify constraints of type: >=a-v1; > a-v2 and such --- o3) therwise sink:-simplify_group_table p (Just v) l@(_) e@(_) oe@(_) exact@(_) = OrLaterVersionOf v p : simplify_group_table p Nothing l e oe exact-simplify_group_table p ol@(Nothing) (Just v) e@(_) oe@(_) exact@(_) = LaterVersionOf v p : simplify_group_table p ol Nothing e oe exact-simplify_group_table p ol@(Nothing) l@(Nothing) (Just v) oe@(_) exact@(_) = EarlierVersionOf v p : simplify_group_table p ol l Nothing oe exact-simplify_group_table p ol@(Nothing) l@(Nothing) e@(Nothing) (Just v) exact@(_) = OrEarlierVersionOf v p : simplify_group_table p ol l e Nothing exact+-- 3) otherwise sink:+simplify_group_table p u (Just v) l@(_) e@(_) oe@(_) exact@(_) = OrLaterVersionOf v p u: simplify_group_table p u Nothing l e oe exact+simplify_group_table p u ol@(Nothing) (Just v) e@(_) oe@(_) exact@(_) = LaterVersionOf v p u: simplify_group_table p u ol Nothing e oe exact+simplify_group_table p u ol@(Nothing) l@(Nothing) (Just v) oe@(_) exact@(_) = EarlierVersionOf v p u: simplify_group_table p u ol l Nothing oe exact+simplify_group_table p u ol@(Nothing) l@(Nothing) e@(Nothing) (Just v) exact@(_) = OrEarlierVersionOf v p u: simplify_group_table p u ol l e Nothing exact -- already defined earlier -- simplify_group_table p ol@(Nothing) l@(Nothing) e@(Nothing) oe@(Nothing) (Just v) = OrEarlierVersionOf v p : simplify_group_table p ol l e oe Nothing @@ -91,9 +92,10 @@ -- key idea: all constraints are enforcing constraints, so we can't get -- more, than one interval. simplify_group :: [Dependency] -> [Dependency]-simplify_group [dep@(AnyVersionOf _package)] = [dep]-simplify_group [dep@(ThisMajorOf _v _p)] = [dep]+simplify_group [dep@(AnyVersionOf _package _u)] = [dep]+simplify_group [dep@(ThisMajorOf _v _p _u)] = [dep] simplify_group deps = simplify_group_table package+ uses min_or_later_v -- >= min_later_v -- > max_earlier_v -- <@@ -101,6 +103,7 @@ exact_this_v -- == where package = fromJust.getPackage $ head deps+ uses = fromJust.getUses $ head deps max_earlier_v = safe_minimum $ map earlier_v deps max_or_earlier_v = safe_minimum $ map or_earlier_v deps min_later_v = safe_maximum $ map later_v deps@@ -110,19 +113,19 @@ [v] -> Just v xs -> error $ "too many exact versions:" ++ show xs --- earlier_v (EarlierVersionOf v _p) = Just v+ earlier_v (EarlierVersionOf v _p _u) = Just v earlier_v _ = Nothing - or_earlier_v (OrEarlierVersionOf v _p) = Just v+ or_earlier_v (OrEarlierVersionOf v _p _u) = Just v or_earlier_v _ = Nothing - later_v (LaterVersionOf v _p) = Just v+ later_v (LaterVersionOf v _p _u) = Just v later_v _ = Nothing - or_later_v (OrLaterVersionOf v _p) = Just v+ or_later_v (OrLaterVersionOf v _p _u) = Just v or_later_v _ = Nothing - this_v (ThisVersionOf v _p) = Just v+ this_v (ThisVersionOf v _p _u) = Just v this_v _ = Nothing -- safe_minimum xs = case catMaybes xs of@@ -145,15 +148,39 @@ cmpMaybe _ _ = False -- getPackage :: Dependency -> Maybe PackageName-getPackage (AnyVersionOf package) = Just package-getPackage (ThisVersionOf _version package) = Just package-getPackage (LaterVersionOf _version package) = Just package-getPackage (EarlierVersionOf _version package) = Just package-getPackage (OrLaterVersionOf _version package) = Just package-getPackage (OrEarlierVersionOf _version package) = Just package+getPackage (AnyVersionOf package _uses) = Just package+getPackage (ThisVersionOf _version package _uses) = Just package+getPackage (LaterVersionOf _version package _uses) = Just package+getPackage (EarlierVersionOf _version package _uses) = Just package+getPackage (OrLaterVersionOf _version package _uses) = Just package+getPackage (OrEarlierVersionOf _version package _uses) = Just package getPackage (DependEither _dependency ) = Nothing getPackage (DependIfUse _useFlag _Dependency) = Nothing-getPackage (ThisMajorOf _version package) = Just package+getPackage (ThisMajorOf _version package _uses) = Just package++getUses :: Dependency -> Maybe [UseFlag]+getUses (AnyVersionOf _p u) = Just u+getUses (ThisVersionOf _v _p u) = Just u+getUses (LaterVersionOf _v _p u) = Just u+getUses (EarlierVersionOf _v _p u) = Just u+getUses (OrLaterVersionOf _v _p u) = Just u+getUses (OrEarlierVersionOf _v _p u) = Just u+getUses (DependEither _d) = Nothing+getUses (DependIfUse _u _d) = Nothing+getUses (ThisMajorOf _v _p u) = Just u+ -- getPackagePart :: Dependency -> PackageName getPackagePart dep = fromJust (getPackage dep)++--+addDepUseFlag :: Dependency -> UseFlag -> Dependency+addDepUseFlag (AnyVersionOf p u) n = AnyVersionOf p (n:u)+addDepUseFlag (ThisVersionOf v p u) n = ThisVersionOf v p (n:u)+addDepUseFlag (LaterVersionOf v p u) n = LaterVersionOf v p (n:u)+addDepUseFlag (EarlierVersionOf v p u) n = EarlierVersionOf v p (n:u)+addDepUseFlag (OrLaterVersionOf v p u) n = OrLaterVersionOf v p (n:u)+addDepUseFlag (OrEarlierVersionOf v p u) n = OrEarlierVersionOf v p (n:u)+addDepUseFlag (ThisMajorOf v p u) n = ThisMajorOf v p (n:u)+addDepUseFlag (DependEither d) n = DependEither $ map (\d' -> map (flip addDepUseFlag n) d') d+addDepUseFlag (DependIfUse u d) n = DependIfUse u (addDepUseFlag d n)
Portage/Host.hs view
@@ -38,7 +38,7 @@ ---------- getPaludisInfo :: IO (Maybe LocalInfo)-getPaludisInfo = fmap parsePaludisInfo <$> run_cmd "paludis --info"+getPaludisInfo = fmap parsePaludisInfo <$> run_cmd "cave info" parsePaludisInfo :: String -> LocalInfo parsePaludisInfo text =@@ -52,16 +52,14 @@ ["Repository", nm] -> return (init nm) _ -> fail "not a repository chunk" let dict = [ (head ln, unwords (tail ln)) | ln <- map words lns ]- location <- lookup "location:" dict- distfiles <- lookup "distdir:" dict+ location <- lookup "location" dict+ distfiles <- lookup "distdir" dict return (name, (location, distfiles)) - knownRepos = ["installed-virtuals", "virtuals", "gentoo", "installed"]- mkLocalInfo :: [(String, (String, String))] -> Maybe LocalInfo mkLocalInfo repos = do (gentooLocation, gentooDistfiles) <- lookup "gentoo" repos- let overlays = [ loc | (name, (loc, _dist)) <- repos, name `notElem` knownRepos ]+ let overlays = [ loc | (name, (loc, _dist)) <- repos ] return (LocalInfo { distfiles_dir = gentooDistfiles , portage_dir = gentooLocation
Portage/Resolve.hs view
@@ -1,6 +1,10 @@ {-# LANGUAGE PatternGuards #-} -module Portage.Resolve where+module Portage.Resolve+ ( resolveCategory+ , resolveCategories+ , resolveFullPortageName+ ) where import qualified Portage.Overlay as Overlay import qualified Portage.PackageId as Portage@@ -69,4 +73,3 @@ , mkC "net-libs" , mkC "sci-libs" ]-
+ Portage/Use.hs view
@@ -0,0 +1,50 @@+module Portage.Use (+ -- * main structures+ UseFlag(..),+ Use,+ dispUses,+ -- * helpers+ mkUse,+ mkNotUse,+ mkQUse+ ) where++import qualified Text.PrettyPrint as Disp+import Text.PrettyPrint ((<>))+import Distribution.Text ( Text(..) )++-- | Use variable modificator+data UseFlag = UseFlag Use -- ^ no modificator+ | E UseFlag -- ^ = modificator (Equiv mark)+ | Q UseFlag -- ^ ? modificator (Question mark)+ | X UseFlag -- ^ ! modificator (eXclamation mark)+ | N UseFlag -- ^ - modificator + deriving (Eq,Show,Ord,Read)++-- |+mkUse :: Use -> UseFlag+mkUse = UseFlag ++mkNotUse :: Use -> UseFlag+mkNotUse = UseFlag++mkQUse :: Use -> UseFlag+mkQUse = Q . UseFlag+++instance Text UseFlag where+ disp = showModificator++showModificator :: UseFlag -> Disp.Doc+showModificator (UseFlag u) = Disp.text u+showModificator (X u) = Disp.char '!' <> disp u+showModificator (Q u) = disp u <> Disp.char '?'+showModificator (E u) = disp u <> Disp.char '='+showModificator (N u) = Disp.char '-' <> disp u++dispUses :: [UseFlag] -> Disp.Doc+dispUses [] = Disp.empty+dispUses us = Disp.brackets $ Disp.hcat $ (Disp.punctuate (Disp.text ", ")) $ map disp us++type Use = String+
Status.hs view
@@ -1,5 +1,6 @@ module Status ( FileStatus(..)+ , StatusDirection(..) , fromStatus , status , runStatus@@ -7,8 +8,11 @@ import AnsiColor +import qualified Portage.Version as V (versionNumber)+ import Portage.Overlay import Portage.PackageId+import Portage.Resolve import Control.Monad.State @@ -17,6 +21,7 @@ import qualified Data.ByteString.Lazy.Char8 as L import Data.Char+import Data.Function (on) import qualified Data.Map as Map import Data.Map as Map (Map) @@ -24,16 +29,29 @@ import Control.Applicative -- cabal+import Distribution.Client.Types ( Repo, SourcePackageDb(..), SourcePackage(..) ) import Distribution.Verbosity-import Distribution.Simple.Utils (equating, comparing)+import Distribution.Package (pkgName)+import Distribution.Simple.Utils (comparing, die, equating) import Distribution.Text ( display, simpleParse )-import Distribution.Simple.Utils ( die ) +import qualified Distribution.Client.PackageIndex as CabalInstall+import qualified Distribution.Client.IndexUtils as CabalInstall++import Hackage (defaultRepo)++data StatusDirection+ = PortagePlusOverlay+ | OverlayToPortage+ | HackageToOverlay+ deriving Eq+ data FileStatus a = Same a | Differs a a | OverlayOnly a | PortageOnly a+ | HackageOnly a deriving (Show,Eq) instance Ord a => Ord (FileStatus a) where@@ -46,6 +64,7 @@ Differs a b -> Differs (f a) (f b) OverlayOnly a -> OverlayOnly (f a) PortageOnly a -> PortageOnly (f a)+ HackageOnly a -> HackageOnly (f a) fromStatus :: FileStatus a -> a fromStatus fs =@@ -54,10 +73,27 @@ Differs a _ -> a -- second status is lost OverlayOnly a -> a PortageOnly a -> a+ HackageOnly a -> a +++loadHackage :: Verbosity -> Distribution.Client.Types.Repo -> Overlay -> IO [[PackageId]]+loadHackage verbosity repo overlay = do+ SourcePackageDb { packageIndex = pindex } <- CabalInstall.getSourcePackages verbosity [repo]+ let get_cat cabal_pkg = case resolveCategories overlay (pkgName cabal_pkg) of+ [cat] -> cat+ _ -> {- ambig -} Category "dev-haskell"+ pkg_infos = map ( reverse . take 3 . reverse -- hackage usually has a ton of older versions+ . map ((\p -> fromCabalPackageId (get_cat p) p)+ . packageInfoId))+ (CabalInstall.allPackagesByName pindex)+ return pkg_infos+ status :: Verbosity -> FilePath -> FilePath -> IO (Map PackageName [FileStatus ExistingEbuild])-status _verbosity portdir overlaydir = do+status verbosity portdir overlaydir = do+ let repo = defaultRepo overlaydir overlay <- loadLazy overlaydir+ hackage <- loadHackage verbosity repo overlay portage <- filterByHerd ("haskell" `elem`) <$> loadLazy portdir let (over, both, port) = portageDiff (overlayMap overlay) (overlayMap portage) @@ -71,10 +107,21 @@ then Same e1 else Differs e1 e2 - let meld = Map.unionsWith (\a b -> List.sort (a++b))+ let p_to_ee :: PackageId -> ExistingEbuild+ p_to_ee p = ExistingEbuild p cabal_p ebuild_path+ where Just cabal_p = toCabalPackageId p -- lame doubleconv+ ebuild_path = packageIdToFilePath p+ mk_fake_ee :: [PackageId] -> (PackageName, [ExistingEbuild])+ mk_fake_ee ~pkgs@(p:_) = (packageId p, map p_to_ee pkgs)++ map_diff = Map.differenceWith (\le re -> Just $ foldr (List.deleteBy (equating ebuildId)) le re)+ hack = ((Map.fromList $ map mk_fake_ee hackage) `map_diff` overlayMap overlay) `map_diff` overlayMap portage++ meld = Map.unionsWith (\a b -> List.sort (a++b)) [ Map.map (map PortageOnly) port , both' , Map.map (map OverlayOnly) over+ , Map.map (map HackageOnly) hack ] return meld @@ -85,10 +132,12 @@ ebuilds <- Map.lookup (packageId pkgid) overlay List.find (\e -> ebuildId e == pkgid) ebuilds -runStatus :: Verbosity -> FilePath -> FilePath -> Bool -> [String] -> IO ()-runStatus verbosity portdir overlaydir toPortageFlag pkgs = do- let pkgFilter | toPortageFlag = toPortageFilter- | otherwise = id+runStatus :: Verbosity -> FilePath -> FilePath -> StatusDirection -> [String] -> IO ()+runStatus verbosity portdir overlaydir direction pkgs = do+ let pkgFilter = case direction of+ OverlayToPortage -> toPortageFilter+ PortagePlusOverlay -> id+ HackageToOverlay -> fromHackageFilter pkgs' <- forM pkgs $ \p -> case simpleParse p of Nothing -> die ("Could not parse package name: " ++ p ++ ". Format cat/pkg")@@ -108,6 +157,7 @@ let inPortage = flip filter sts $ \st -> case st of OverlayOnly _ -> False+ HackageOnly _ -> False _ -> True latestPortageVersion = List.maximum $ map (pkgVersion . ebuildId . fromStatus) inPortage interestingPackages = flip filter sts $ \st ->@@ -119,12 +169,29 @@ then Just sts else Nothing +-- |Only return packages that exist in overlay or portage but look outdated+fromHackageFilter :: Map PackageName [FileStatus ExistingEbuild] -> Map PackageName [FileStatus ExistingEbuild]+fromHackageFilter = Map.mapMaybe $ \ sts ->+ let inEbuilds = flip filter sts $ \st ->+ case st of+ HackageOnly _ -> False+ _ -> True+ -- treat versionNumber=[9999*] as oldest version not avoid masking hackage releases+ mangle_live_versions v = case V.versionNumber v of+ [n] | n >= 9999 && (all (== '9') . show) n -> v {versionNumber=[-1]}+ _ -> v+ latestVersion = List.maximumBy (compare `on` mangle_live_versions . pkgVersion . ebuildId . fromStatus) sts+ in case latestVersion of+ HackageOnly _ | not (null inEbuilds) -> Just sts+ _ -> Nothing+ statusPrinter :: Map PackageName [FileStatus ExistingEbuild] -> IO () statusPrinter packages = do putStrLn $ toColor (Same "Green") ++ ": package in portage and overlay are the same" putStrLn $ toColor (Differs "Yellow" "") ++ ": package in portage and overlay differs" putStrLn $ toColor (OverlayOnly "Red") ++ ": package only exist in the overlay" putStrLn $ toColor (PortageOnly "Magenta") ++ ": package only exist in the portage tree"+ putStrLn $ toColor (HackageOnly "Cyan") ++ ": package only exist on hackage" forM_ (Map.toAscList packages) $ \(pkg, ebuilds) -> do let (PackageName c p) = pkg putStr $ display c ++ '/' : bold (display p)@@ -142,7 +209,7 @@ (Differs _ _) -> Yellow (OverlayOnly _) -> Red (PortageOnly _) -> Magenta-+ (HackageOnly _) -> Cyan portageDiff :: EMap -> EMap -> (EMap, EMap, EMap) portageDiff p1 p2 = (in1, ins, in2)@@ -171,4 +238,3 @@ essence = filter (not . isEmpty) . filter (not . isComment) . L.lines isComment = L.isPrefixOf (L.pack "#") . L.dropWhile isSpace isEmpty = L.null . L.dropWhile isSpace-
hackport.cabal view
@@ -1,5 +1,5 @@ Name: hackport-Version: 0.2.16+Version: 0.2.17 License: GPL License-file: LICENSE Author: Henning Günther, Duncan Coutts, Lennart Kolmodin@@ -68,9 +68,10 @@ CacheFile Diff Error- Paths_hackport+ Hackage Main Overlays+ Paths_hackport Portage.Version Portage.Dependency Portage.GHCCore
tests/resolveCat.hs view
@@ -3,6 +3,7 @@ import qualified Portage.Overlay as Portage import qualified Portage.Resolve as Portage import qualified Portage.PackageId as Portage+import qualified Portage.Host as Portage import qualified Distribution.Package as Cabal @@ -12,7 +13,8 @@ test_resolveCategory :: String -> String -> Test test_resolveCategory cat pkg = TestCase $ do- portage <- Portage.loadLazy "/usr/portage"+ portage_dir <- Portage.portage_dir `fmap` Portage.getInfo+ portage <- Portage.loadLazy portage_dir let cabal = Cabal.PackageName pkg hits = Portage.resolveFullPortageName portage cabal expected = Just (Portage.PackageName (Portage.Category cat) cabal)
− unused/Fetch.hs
@@ -1,78 +0,0 @@--- module unused-module Fetch(downloadTarball,downloadFileVerify) where--import Prelude hiding (catch)--import Network.HTTP (ConnError(..),Request(..),simpleHTTP- ,Response(..),RequestMethod(..))-import Network.URI (URI,uriPath,parseURI)-import Text.Regex (Regex,mkRegex,matchRegex)-import System.GPG-import Control.Monad.Error-import System.Directory-import System.FilePath-import Data.Typeable--import Error-import Action--filenameRegex :: Regex-filenameRegex = mkRegex "^.*?/([^/]*?)"--uriToFileName :: URI -> Maybe FilePath-uriToFileName uri = maybe Nothing (\x->Just (head x)) (matchRegex filenameRegex (uriPath uri))--downloadURI :: FilePath -- ^ a directory to store the file- -> URI -- ^ the url- -> IO FilePath -- ^ the path of the downloaded file-downloadURI path uri = do- fileName <- maybe (throwEx $ InvalidTarballURL (show uri) "URL doesn't contain a filename") return (uriToFileName uri)- httpResult <- simpleHTTP request- Response {rspCode=code,rspBody=body,rspReason=reason} <- either (\x->throwError $ DownloadFailed (show uri) "Connection failed") return httpResult- if code==(2,0,0) then (do- let writePath=path </> fileName- writeFile writePath body- return writePath) else throwEx $ DownloadFailed (show uri) ("Code "++show code++":"++reason)- where- request = Request- {rqURI=uri- ,rqMethod=GET- ,rqHeaders=[]- ,rqBody=""}---downloadFileVerify ::- FilePath -> -- ^ the directory to store the files- String -> -- ^ the url of the tarball- String -> -- ^ the url of the signature- IO (FilePath,FilePath) -- ^ the tarballs and signatures path-downloadFileVerify path url sigurl = do- tarballPath <- downloadTarball path url- sigPath <- downloadSig path sigurl `catchEx` \e-> do- removeFile tarballPath- throwEx x- verified <- verifyFile stdOptions tarballPath sigPath- if verified then return (tarballPath,sigPath) else (do- removeFile tarballPath- removeFile sigPath- throwEx $ VerificationFailed url sigurl)--downloadTarball ::- FilePath ->- String ->- IO FilePath-downloadTarball dir url = download dir url InvalidTarballURL--downloadSig ::- FilePath ->- String ->- IO FilePath-downloadSig dir url = download dir url InvalidSignatureURL--download :: FilePath -- ^ the folder to store the file in- -> String -- ^ the url- -> (String -> String -> HackPortError) -- ^ a function to construct an error- -> IO FilePath -- ^ the resulting file's path-download dir url errFunc = do- parsedURL <- maybe (throwEx $ errFunc url "Parsing failed") return (parseURI url)- downloadURI dir parsedURL