diff --git a/Cabal2Ebuild.hs b/Cabal2Ebuild.hs --- a/Cabal2Ebuild.hs +++ b/Cabal2Ebuild.hs @@ -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 diff --git a/Hackage.hs b/Hackage.hs new file mode 100644 --- /dev/null +++ b/Hackage.hs @@ -0,0 +1,32 @@ +{-| + Author : Sergei Trofimovich + 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 diff --git a/Main.hs b/Main.hs --- a/Main.hs +++ b/Main.hs @@ -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 = diff --git a/Merge.hs b/Merge.hs --- a/Merge.hs +++ b/Merge.hs @@ -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) diff --git a/Merge/Dependencies.hs b/Merge/Dependencies.hs --- a/Merge/Dependencies.hs +++ b/Merge/Dependencies.hs @@ -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 = diff --git a/Portage/Dependency.hs b/Portage/Dependency.hs --- a/Portage/Dependency.hs +++ b/Portage/Dependency.hs @@ -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 - | 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 + | 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 =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) diff --git a/Portage/Host.hs b/Portage/Host.hs --- a/Portage/Host.hs +++ b/Portage/Host.hs @@ -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 diff --git a/Portage/Resolve.hs b/Portage/Resolve.hs --- a/Portage/Resolve.hs +++ b/Portage/Resolve.hs @@ -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" ] - diff --git a/Portage/Use.hs b/Portage/Use.hs new file mode 100644 --- /dev/null +++ b/Portage/Use.hs @@ -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 + diff --git a/Status.hs b/Status.hs --- a/Status.hs +++ b/Status.hs @@ -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 - diff --git a/hackport.cabal b/hackport.cabal --- a/hackport.cabal +++ b/hackport.cabal @@ -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 diff --git a/tests/resolveCat.hs b/tests/resolveCat.hs --- a/tests/resolveCat.hs +++ b/tests/resolveCat.hs @@ -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) diff --git a/unused/Fetch.hs b/unused/Fetch.hs deleted file mode 100644 --- a/unused/Fetch.hs +++ /dev/null @@ -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