Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Newer
Older
100644 135 lines (119 sloc) 5.104 kB
cae915c @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)
7601f3d @trofi query-emerge-only-if-no-paludis
trofi authored
8 import Data.Maybe (fromJust, isJust)
82cf87c @kolmodin Fix finding paludis overlays
kolmodin authored
9 import Control.Applicative ( (<$>) )
cae915c @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 @kolmodin Fix finding paludis overlays
kolmodin authored
15 } deriving Show
cae915c @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 @trofi query-emerge-only-if-no-paludis
trofi authored
25 getInfo = fromJust `fmap`
82cf87c @kolmodin Fix finding paludis overlays
kolmodin authored
26 performMaybes [ getPaludisInfo
7601f3d @trofi query-emerge-only-if-no-paludis
trofi authored
27 , (fmap . fmap) parse_emerge_output (run_cmd "emerge --info")
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 @kolmodin Add missing Host.hs
kolmodin authored
36
37 data LocalPaludisOverlay =
38 LocalPaludisOverlay { repo_name :: String
39 , format :: String
40 , location :: FilePath
41 , distdir :: FilePath
42 }
43
44 bad_paludis_overlay :: LocalPaludisOverlay
45 bad_paludis_overlay =
46 LocalPaludisOverlay { repo_name = undefined
47 , format = undefined
48 , location = undefined
49 , distdir = undefined
50 }
51
82cf87c @kolmodin Fix finding paludis overlays
kolmodin authored
52 getPaludisInfo :: IO (Maybe LocalInfo)
53 getPaludisInfo = do
54 mp <- fmap paludisParseRepositories <$> run_cmd "paludis --list-repositories"
55 case mp of
56 Nothing -> return Nothing
57 Just repos0 -> Just <$> do
58 let repos = filter (`notElem` knownRepos) repos0
59 Just gentooLocation <- paludisRepositoryLocation "gentoo"
60 Just gentooDistdir <- paludisRepositoryDistdir "gentoo"
61 others <- map fromJust <$> mapM paludisRepositoryLocation repos
62 return (LocalInfo
63 { distfiles_dir = gentooDistdir
64 , overlay_list = others
65 , portage_dir = gentooLocation
66 })
67 where
68 knownRepos = ["installed-virtuals", "virtuals", "gentoo", "installed"]
69
70 paludisParseRepositories :: String -> [String]
71 paludisParseRepositories = map (tail . tail) . lines
72 {- * installed-virtuals
73 * virtuals
74 * gentoo
75 * installed
76 * gentoo-haskell -}
77
78 paludisRepositoryLocation :: String -> IO (Maybe String)
79 paludisRepositoryLocation repo = fmap init <$> run_cmd ("paludis --configuration-variable " ++ repo ++ " location")
80
81 paludisRepositoryDistdir :: String -> IO (Maybe String)
82 paludisRepositoryDistdir repo = fmap init <$> run_cmd ("paludis --configuration-variable " ++ repo ++ " distdir")
83
cae915c @kolmodin Add missing Host.hs
kolmodin authored
84 parse_paludis_output :: String -> LocalInfo
85 parse_paludis_output raw_data =
86 foldl updateInfo defaultInfo $ parse_paludis_overlays raw_data
87 where updateInfo info po =
88 case (format po) of
89 "ebuild" | (repo_name po) /= "gentoo" -- hack, skip main repo
90 -> info{ distfiles_dir = distdir po -- we override last distdir here (FIXME?)
91 , overlay_list = (location po) : overlay_list info
92 }
93 "ebuild" -- hack, main repo -- (repo_name po) == "gentoo"
94 -> info{ portage_dir = location po }
95
96 _ -> info
97
98 parse_paludis_overlays :: String -> [LocalPaludisOverlay]
99 parse_paludis_overlays raw_data =
100 parse_paludis_overlays' (reverse $ lines raw_data) bad_paludis_overlay
101
102 -- parse in reverse order :]
103 parse_paludis_overlays' :: [String] -> LocalPaludisOverlay -> [LocalPaludisOverlay]
104 parse_paludis_overlays' [] _ = []
105 parse_paludis_overlays' (l:ls) info =
106 case (words l) of
107 -- look for "Repository <repo-name>:"
108 ["Repository", r_name] -> info{repo_name = init r_name} :
109 go bad_paludis_overlay
110 -- else - parse attributes
111 _ -> case (break (== ':') (refine l)) of
112 ("location", ':':value)
113 -> go info{location = refine value}
114 ("distdir", ':':value)
115 -> go info{distdir = refine value}
116 ("format", ':':value)
117 -> go info{format = refine value}
118 _ -> go info
119 where go = parse_paludis_overlays' ls
120 refine = dropWhile isSpace
121
122 parse_emerge_output :: String -> LocalInfo
123 parse_emerge_output raw_data =
124 foldl updateInfo defaultInfo $ lines raw_data
125 where updateInfo info str =
126 case (break (== '=') str) of
127 ("DISTDIR", '=':value)
128 -> info{distfiles_dir = unquote value}
129 ("PORTDIR", '=':value)
130 -> info{portage_dir = unquote value}
131 ("PORTDIR_OVERLAY", '=':value)
132 -> info{overlay_list = words $ unquote value}
133 _ -> info
134 unquote = init . tail
Something went wrong with that request. Please try again.