Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse code

Added basic repository location discovery (currently disfiles dir via…

… paludis and then emerge)
  • Loading branch information...
commit 830d9bb3d5ff117d89f7c15ebbeaa554e276a5b5 1 parent 285f6b1
Sergei Trofimovich authored March 15, 2009
3  Merge.hs
@@ -337,7 +337,8 @@ fetchAndDigest verbosity ebuildDir tarballName tarballURI =
337 337
     case e_response of
338 338
       Left err -> throwEx (E.DownloadFailed (show tarballURI) (show err))
339 339
       Right response -> do
340  
-        let tarDestination = "/usr/portage/distfiles" </> tarballName
  340
+        repo_info <- Overlay.getInfo
  341
+        let tarDestination = (Overlay.distfiles_dir repo_info) </> tarballName
341 342
         notice verbosity $ "Saving to " ++ tarDestination
342 343
         writeFile tarDestination (rspBody response)
343 344
         notice verbosity "Recalculating digests..."
42  Portage/Overlay.hs
@@ -4,6 +4,8 @@ module Portage.Overlay
4 4
   , load, loadLazy
5 5
   , reduceOverlay
6 6
   , inOverlay
  7
+  , getInfo -- :: IO [(String, String)]
  8
+  , LocalInfo(..)
7 9
   )
8 10
   where
9 11
 
@@ -23,6 +25,11 @@ import System.Directory (getDirectoryContents, doesDirectoryExist)
23 25
 import System.IO.Unsafe (unsafeInterleaveIO)
24 26
 import System.FilePath  ((</>), splitExtension)
25 27
 
  28
+import Util (run_cmd)
  29
+import Control.Monad (mplus)
  30
+import Data.Char (isSpace)
  31
+import Data.Maybe (fromJust)
  32
+
26 33
 --main = do
27 34
 --  pkgs <- blingProgress . Progress.fromList . readOverlay
28 35
 --      =<< getDirectoryTree "."
@@ -167,3 +174,38 @@ getDirectoryTree = dirEntries
167 174
     ignore ['.']      = True
168 175
     ignore ['.', '.'] = True
169 176
     ignore _          = False
  177
+
  178
+
  179
+data LocalInfo =
  180
+    LocalInfo { distfiles_dir :: String
  181
+              }
  182
+    deriving (Show)
  183
+
  184
+defaultInfo :: LocalInfo
  185
+defaultInfo = LocalInfo { distfiles_dir = "/usr/portage/distfiles" }
  186
+
  187
+-- query paludis and then emerge
  188
+getInfo :: IO LocalInfo
  189
+getInfo = do paludis_info <- (fmap . fmap) parse_paludis_output (run_cmd "paludis --info")
  190
+             emerge_info <- (fmap . fmap) parse_emerge_output (run_cmd "emerge --info")
  191
+             return $ fromJust $ paludis_info `mplus` emerge_info `mplus` (Just defaultInfo)
  192
+
  193
+parse_paludis_output :: String -> LocalInfo
  194
+parse_paludis_output raw_data =
  195
+    foldl updateInfo defaultInfo $ lines raw_data
  196
+    where updateInfo info str =
  197
+              case (break (== ':') (refine str)) of
  198
+                  -- TODO: not quite true. shoud parse info on 'by repo' basis
  199
+                  -- TODO: we are interested in 'Repository gentoo:' actually
  200
+                  ("distdir", ':':value) -> info{distfiles_dir = refine value}
  201
+                  _ -> info
  202
+          refine = dropWhile isSpace
  203
+
  204
+parse_emerge_output :: String -> LocalInfo
  205
+parse_emerge_output raw_data =
  206
+    foldl updateInfo defaultInfo $ lines raw_data
  207
+    where updateInfo info str =
  208
+              case (break (== '=') str) of
  209
+                  ("DISTDIR", '=':value) -> info{distfiles_dir = unquote value}
  210
+                  _                      -> info
  211
+          unquote = init . tail
1  hackport.cabal
@@ -64,3 +64,4 @@ Executable	hackport
64 64
     Setup
65 65
     Status
66 66
     Merge
  67
+    Util

0 notes on commit 830d9bb

Please sign in to comment.
Something went wrong with that request. Please try again.