Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100644 96 lines (83 sloc) 3.142 kb
cae915c Lennart Kolmodin Add missing Host.hs
kolmodin authored
1 module Portage.Host
2 ( getInfo -- :: IO [(String, String)]
3 , LocalInfo(..)
4 ) where
5
6 import Util (run_cmd)
7 import Data.Char (isSpace)
d910639 Lennart Kolmodin Implement a faster lookup of paludis repositories
kolmodin authored
8 import Data.Maybe (fromJust, isJust, catMaybes)
82cf87c Lennart Kolmodin Fix finding paludis overlays
kolmodin authored
9 import Control.Applicative ( (<$>) )
cae915c Lennart Kolmodin Add missing Host.hs
kolmodin authored
10
11 data LocalInfo =
12 LocalInfo { distfiles_dir :: String
13 , overlay_list :: [FilePath]
14 , portage_dir :: FilePath
82cf87c Lennart Kolmodin Fix finding paludis overlays
kolmodin authored
15 } deriving Show
cae915c Lennart Kolmodin Add missing Host.hs
kolmodin authored
16
17 defaultInfo :: LocalInfo
18 defaultInfo = LocalInfo { distfiles_dir = "/usr/portage/distfiles"
19 , overlay_list = []
20 , portage_dir = "/usr/portage"
21 }
22
23 -- query paludis and then emerge
24 getInfo :: IO LocalInfo
7601f3d Sergei Trofimovich query-emerge-only-if-no-paludis
trofi authored
25 getInfo = fromJust `fmap`
82cf87c Lennart Kolmodin Fix finding paludis overlays
kolmodin authored
26 performMaybes [ getPaludisInfo
d910639 Lennart Kolmodin Implement a faster lookup of paludis repositories
kolmodin authored
27 , fmap parse_emerge_output <$> (run_cmd "emerge --info")
7601f3d Sergei Trofimovich query-emerge-only-if-no-paludis
trofi authored
28 , return (Just defaultInfo)
29 ]
30 where performMaybes [] = return Nothing
31 performMaybes (act:acts) =
32 do r <- act
33 if isJust r
34 then return r
35 else performMaybes acts
cae915c Lennart Kolmodin Add missing Host.hs
kolmodin authored
36
d910639 Lennart Kolmodin Implement a faster lookup of paludis repositories
kolmodin authored
37 ----------
38 -- Paludis
39 ----------
cae915c Lennart Kolmodin Add missing Host.hs
kolmodin authored
40
82cf87c Lennart Kolmodin Fix finding paludis overlays
kolmodin authored
41 getPaludisInfo :: IO (Maybe LocalInfo)
d910639 Lennart Kolmodin Implement a faster lookup of paludis repositories
kolmodin authored
42 getPaludisInfo = fmap parsePaludisInfo <$> run_cmd "paludis --info"
82cf87c Lennart Kolmodin Fix finding paludis overlays
kolmodin authored
43
d910639 Lennart Kolmodin Implement a faster lookup of paludis repositories
kolmodin authored
44 parsePaludisInfo :: String -> LocalInfo
45 parsePaludisInfo text =
46 let chunks = splitBy (=="") . lines $ text
47 repositories = catMaybes (map parseRepository chunks)
48 in fromJust (mkLocalInfo repositories)
49 where
50 parseRepository :: [String] -> Maybe (String, (String, String))
51 parseRepository (firstLine:lns) = do
52 name <- case words firstLine of
53 ["Repository", nm] -> return (init nm)
54 _ -> fail "not a repository chunk"
55 let dict = [ (head ln, unwords (tail ln)) | ln <- map words lns ]
56 location <- lookup "location:" dict
57 distfiles <- lookup "distdir:" dict
58 return (name, (location, distfiles))
82cf87c Lennart Kolmodin Fix finding paludis overlays
kolmodin authored
59
d910639 Lennart Kolmodin Implement a faster lookup of paludis repositories
kolmodin authored
60 knownRepos = ["installed-virtuals", "virtuals", "gentoo", "installed"]
cae915c Lennart Kolmodin Add missing Host.hs
kolmodin authored
61
d910639 Lennart Kolmodin Implement a faster lookup of paludis repositories
kolmodin authored
62 mkLocalInfo :: [(String, (String, String))] -> Maybe LocalInfo
63 mkLocalInfo repos = do
64 (gentooLocation, gentooDistfiles) <- lookup "gentoo" repos
65 let overlays = [ loc | (name, (loc, _dist)) <- repos, name `notElem` knownRepos ]
66 return (LocalInfo
67 { distfiles_dir = gentooDistfiles
68 , portage_dir = gentooLocation
69 , overlay_list = overlays
70 })
cae915c Lennart Kolmodin Add missing Host.hs
kolmodin authored
71
d910639 Lennart Kolmodin Implement a faster lookup of paludis repositories
kolmodin authored
72 splitBy :: (a -> Bool) -> [a] -> [[a]]
73 splitBy c [] = []
74 splitBy c lst =
75 let (x,xs) = break c lst
76 (_,xs') = span c xs
77 in x : splitBy c xs'
cae915c Lennart Kolmodin Add missing Host.hs
kolmodin authored
78
d910639 Lennart Kolmodin Implement a faster lookup of paludis repositories
kolmodin authored
79 ---------
80 -- Emerge
81 ---------
cae915c Lennart Kolmodin Add missing Host.hs
kolmodin authored
82
83 parse_emerge_output :: String -> LocalInfo
84 parse_emerge_output raw_data =
85 foldl updateInfo defaultInfo $ lines raw_data
86 where updateInfo info str =
87 case (break (== '=') str) of
88 ("DISTDIR", '=':value)
89 -> info{distfiles_dir = unquote value}
90 ("PORTDIR", '=':value)
91 -> info{portage_dir = unquote value}
92 ("PORTDIR_OVERLAY", '=':value)
93 -> info{overlay_list = words $ unquote value}
94 _ -> info
95 unquote = init . tail
Something went wrong with that request. Please try again.