/
Host.hs
92 lines (81 loc) · 2.94 KB
/
Host.hs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
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