Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Fetching contributors…

Cannot retrieve contributors at this time

93 lines (81 sloc) 3.007 kB
module Portage.Host
( getInfo -- :: IO [(String, String)]
, LocalInfo(..)
) where
import Util (run_cmd)
import Data.Maybe (fromJust, isJust, catMaybes)
import Control.Applicative ( (<$>) )
data LocalInfo =
LocalInfo { distfiles_dir :: String
, overlay_list :: [FilePath]
, portage_dir :: FilePath
} deriving Show
defaultInfo :: LocalInfo
defaultInfo = LocalInfo { distfiles_dir = "/usr/portage/distfiles"
, overlay_list = []
, portage_dir = "/usr/portage"
}
-- query paludis and then emerge
getInfo :: IO LocalInfo
getInfo = fromJust `fmap`
performMaybes [ getPaludisInfo
, fmap parse_emerge_output <$> (run_cmd "emerge --info")
, return (Just defaultInfo)
]
where performMaybes [] = return Nothing
performMaybes (act:acts) =
do r <- act
if isJust r
then return r
else performMaybes acts
----------
-- Paludis
----------
getPaludisInfo :: IO (Maybe LocalInfo)
getPaludisInfo = fmap parsePaludisInfo <$> run_cmd "cave info"
parsePaludisInfo :: String -> LocalInfo
parsePaludisInfo text =
let chunks = splitBy (=="") . lines $ text
repositories = catMaybes (map parseRepository chunks)
in fromJust (mkLocalInfo repositories)
where
parseRepository :: [String] -> Maybe (String, (String, String))
parseRepository (firstLine:lns) = do
name <- case words firstLine of
["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
return (name, (location, distfiles))
mkLocalInfo :: [(String, (String, String))] -> Maybe LocalInfo
mkLocalInfo repos = do
(gentooLocation, gentooDistfiles) <- lookup "gentoo" repos
let overlays = [ loc | (name, (loc, _dist)) <- repos ]
return (LocalInfo
{ distfiles_dir = gentooDistfiles
, portage_dir = gentooLocation
, overlay_list = overlays
})
splitBy :: (a -> Bool) -> [a] -> [[a]]
splitBy c [] = []
splitBy c lst =
let (x,xs) = break c lst
(_,xs') = span c xs
in x : splitBy c xs'
---------
-- Emerge
---------
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
Jump to Line
Something went wrong with that request. Please try again.