Permalink
Browse files

Added basic repository location discovery (currently disfiles dir via…

… paludis and then emerge)
  • Loading branch information...
1 parent 285f6b1 commit 830d9bb3d5ff117d89f7c15ebbeaa554e276a5b5 @trofi trofi committed Mar 15, 2009
Showing with 45 additions and 1 deletion.
  1. +2 −1 Merge.hs
  2. +42 −0 Portage/Overlay.hs
  3. +1 −0 hackport.cabal
View
3 Merge.hs
@@ -337,7 +337,8 @@ fetchAndDigest verbosity ebuildDir tarballName tarballURI =
case e_response of
Left err -> throwEx (E.DownloadFailed (show tarballURI) (show err))
Right response -> do
- let tarDestination = "/usr/portage/distfiles" </> tarballName
+ repo_info <- Overlay.getInfo
+ let tarDestination = (Overlay.distfiles_dir repo_info) </> tarballName
notice verbosity $ "Saving to " ++ tarDestination
writeFile tarDestination (rspBody response)
notice verbosity "Recalculating digests..."
View
42 Portage/Overlay.hs
@@ -4,6 +4,8 @@ module Portage.Overlay
, load, loadLazy
, reduceOverlay
, inOverlay
+ , getInfo -- :: IO [(String, String)]
+ , LocalInfo(..)
)
where
@@ -23,6 +25,11 @@ import System.Directory (getDirectoryContents, doesDirectoryExist)
import System.IO.Unsafe (unsafeInterleaveIO)
import System.FilePath ((</>), splitExtension)
+import Util (run_cmd)
+import Control.Monad (mplus)
+import Data.Char (isSpace)
+import Data.Maybe (fromJust)
+
--main = do
-- pkgs <- blingProgress . Progress.fromList . readOverlay
-- =<< getDirectoryTree "."
@@ -167,3 +174,38 @@ getDirectoryTree = dirEntries
ignore ['.'] = True
ignore ['.', '.'] = True
ignore _ = False
+
+
+data LocalInfo =
+ LocalInfo { distfiles_dir :: String
+ }
+ deriving (Show)
+
+defaultInfo :: LocalInfo
+defaultInfo = LocalInfo { distfiles_dir = "/usr/portage/distfiles" }
+
+-- query paludis and then emerge
+getInfo :: IO LocalInfo
+getInfo = do paludis_info <- (fmap . fmap) parse_paludis_output (run_cmd "paludis --info")
+ emerge_info <- (fmap . fmap) parse_emerge_output (run_cmd "emerge --info")
+ return $ fromJust $ paludis_info `mplus` emerge_info `mplus` (Just defaultInfo)
+
+parse_paludis_output :: String -> LocalInfo
+parse_paludis_output raw_data =
+ foldl updateInfo defaultInfo $ lines raw_data
+ where updateInfo info str =
+ case (break (== ':') (refine str)) of
+ -- TODO: not quite true. shoud parse info on 'by repo' basis
+ -- TODO: we are interested in 'Repository gentoo:' actually
+ ("distdir", ':':value) -> info{distfiles_dir = refine value}
+ _ -> info
+ refine = dropWhile isSpace
+
+parse_emerge_output :: String -> LocalInfo
+parse_emerge_output raw_data =
+ foldl updateInfo defaultInfo $ lines raw_data
+ where updateInfo info str =
+ case (break (== '=') str) of
+ ("DISTDIR", '=':value) -> info{distfiles_dir = unquote value}
+ _ -> info
+ unquote = init . tail
View
1 hackport.cabal
@@ -64,3 +64,4 @@ Executable hackport
Setup
Status
Merge
+ Util

0 comments on commit 830d9bb

Please sign in to comment.