Permalink
Browse files

Move host information code into Portage.Host

  • Loading branch information...
1 parent e203713 commit 27f08f37c7f4aa36f5ac1c3d1df744ff8ca53db9 @kolmodin kolmodin committed Mar 23, 2009
Showing with 9 additions and 99 deletions.
  1. +3 −2 Main.hs
  2. +4 −3 Merge.hs
  3. +1 −1 Overlays.hs
  4. +0 −93 Portage/Overlay.hs
  5. +1 −0 hackport.cabal
View
@@ -30,7 +30,8 @@ import Distribution.Client.Types
import Distribution.Client.Update
import qualified Distribution.Client.IndexUtils as Index
-import Portage.Overlay as Overlay ( loadLazy, inOverlay, getInfo, LocalInfo(..) )
+import Portage.Overlay as Overlay ( loadLazy, inOverlay )
+import Portage.Host as Host ( getInfo, portage_dir )
import Portage.PackageId ( normalizeCabalPackageId )
import Network.URI
@@ -357,7 +358,7 @@ statusAction flags args _globalFlags = do
overlayPathM = flagToMaybe (statusOverlayPath flags)
portdirM = flagToMaybe (statusPortdirPath flags)
toPortdir = fromFlag (statusToPortage flags)
- portdir <- maybe (Overlay.portage_dir `fmap` Overlay.getInfo) return portdirM
+ portdir <- maybe (Host.portage_dir `fmap` Host.getInfo) return portdirM
overlayPath <- maybe (getOverlayPath verbosity) return overlayPathM
runStatus verbosity portdir overlayPath toPortdir args
View
@@ -52,6 +52,7 @@ import Distribution.Client.Types
import qualified Portage.PackageId as Portage
import qualified Portage.Version as Portage
+import qualified Portage.Host as Host
import qualified Portage.Overlay as Overlay
import Cabal2Ebuild
@@ -179,7 +180,7 @@ merge verbosity repo serverURI args = do
overlayPath <- getOverlayPath verbosity
overlay <- Overlay.loadLazy overlayPath
- portage_path <- Overlay.portage_dir `fmap` Overlay.getInfo
+ portage_path <- Host.portage_dir `fmap` Host.getInfo
portage <- Overlay.loadLazy portage_path
index <- fmap packageIndex $ getAvailablePackages verbosity [ repo ]
@@ -338,8 +339,8 @@ fetchAndDigest verbosity ebuildDir tarballName tarballURI =
case e_response of
Left err -> throwEx (E.DownloadFailed (show tarballURI) (show err))
Right response -> do
- repo_info <- Overlay.getInfo
- let tarDestination = (Overlay.distfiles_dir repo_info) </> tarballName
+ repo_info <- Host.getInfo
+ let tarDestination = (Host.distfiles_dir repo_info) </> tarballName
notice verbosity $ "Saving to " ++ tarDestination
writeFile tarDestination (rspBody response)
notice verbosity "Recalculating digests..."
View
@@ -8,7 +8,7 @@ import System.FilePath ((</>), splitPath, joinPath)
import Error
import CacheFile
-import Portage.Overlay
+import Portage.Host
-- cabal
import Distribution.Verbosity
View
@@ -4,8 +4,6 @@ module Portage.Overlay
, load, loadLazy
, reduceOverlay
, inOverlay
- , getInfo -- :: IO [(String, String)]
- , LocalInfo(..)
)
where
@@ -25,11 +23,6 @@ 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 "."
@@ -174,89 +167,3 @@ getDirectoryTree = dirEntries
ignore ['.'] = True
ignore ['.', '.'] = True
ignore _ = False
-
-
-data LocalInfo =
- LocalInfo { distfiles_dir :: String
- , overlay_list :: [FilePath]
- , portage_dir :: FilePath
- }
-
-defaultInfo :: LocalInfo
-defaultInfo = LocalInfo { distfiles_dir = "/usr/portage/distfiles"
- , overlay_list = []
- , portage_dir = "/usr/portage"
- }
-
--- 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)
-
-data LocalPaludisOverlay =
- LocalPaludisOverlay { repo_name :: String
- , format :: String
- , location :: FilePath
- , distdir :: FilePath
- }
-
-bad_paludis_overlay :: LocalPaludisOverlay
-bad_paludis_overlay =
- LocalPaludisOverlay { repo_name = undefined
- , format = undefined
- , location = undefined
- , distdir = undefined
- }
-
-parse_paludis_output :: String -> LocalInfo
-parse_paludis_output raw_data =
- foldl updateInfo defaultInfo $ parse_paludis_overlays raw_data
- where updateInfo info po =
- case (format po) of
- "ebuild" | (repo_name po) /= "gentoo" -- hack, skip main repo
- -> info{ distfiles_dir = distdir po -- we override last distdir here (FIXME?)
- , overlay_list = (location po) : overlay_list info
- }
- "ebuild" -- hack, main repo -- (repo_name po) == "gentoo"
- -> info{ portage_dir = location po }
-
- _ -> info
-
-parse_paludis_overlays :: String -> [LocalPaludisOverlay]
-parse_paludis_overlays raw_data =
- parse_paludis_overlays' (reverse $ lines raw_data) bad_paludis_overlay
-
--- parse in reverse order :]
-parse_paludis_overlays' :: [String] -> LocalPaludisOverlay -> [LocalPaludisOverlay]
-parse_paludis_overlays' [] _ = []
-parse_paludis_overlays' (l:ls) info =
- case (words l) of
- -- look for "Repository <repo-name>:"
- ["Repository", r_name] -> info{repo_name = init r_name} :
- go bad_paludis_overlay
- -- else - parse attributes
- _ -> case (break (== ':') (refine l)) of
- ("location", ':':value)
- -> go info{location = refine value}
- ("distdir", ':':value)
- -> go info{distdir = refine value}
- ("format", ':':value)
- -> go info{format = refine value}
- _ -> go info
- where go = parse_paludis_overlays' ls
- 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}
- ("PORTDIR", '=':value)
- -> info{portage_dir = unquote value}
- ("PORTDIR_OVERLAY", '=':value)
- -> info{overlay_list = words $ unquote value}
- _ -> info
- unquote = init . tail
View
@@ -60,6 +60,7 @@ Executable hackport
Portage.Version
Portage.PackageId
Portage.Overlay
+ Portage.Host
Setup
Status
Merge

0 comments on commit 27f08f3

Please sign in to comment.