Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100644 154 lines (123 sloc) 5.662 kb
993967c @trofi initial commit
trofi authored
1 module Main ( main ) where
2
3 import Control.Applicative ((<$>))
a903633 @trofi optimized directory traversal (stop ASAP on tree mismatch)
trofi authored
4 import Control.Monad (forM_, when)
993967c @trofi initial commit
trofi authored
5
6 import Data.Char (isSpace)
a903633 @trofi optimized directory traversal (stop ASAP on tree mismatch)
trofi authored
7 import Data.List (findIndices, intercalate, isPrefixOf, sort)
993967c @trofi initial commit
trofi authored
8 import qualified Data.Map as M
9
10 import System.Directory (getDirectoryContents)
11 import System.FilePath ((</>))
a903633 @trofi optimized directory traversal (stop ASAP on tree mismatch)
trofi authored
12 import System.Posix.Files (fileExist, getFileStatus, isDirectory, isRegularFile)
993967c @trofi initial commit
trofi authored
13 import System.Environment (getArgs)
14 import System.Exit (exitWith, ExitCode(..))
15
16 usage :: IO ()
17 usage =
18 do putStrLn "usage: syn-kw [-p] <from-tree> <to-tree>"
19 exitWith (ExitFailure 1)
20
21 debug :: String -> IO ()
22 debug str =
23 do putStrLn str
24 return ()
25
26 info :: String -> IO ()
27 info str =
28 do putStrLn str
29 return ()
30
31 -- We rely on sort order here
32 data Mark = Masked
33 | Keyworded
34 | Stable
35 deriving (Eq, Ord)
36
37 instance Show Mark where
38 show Masked = "-"
39 show Keyworded = "~"
40 show Stable = ""
41
42 -- We rely on sort order here
43 data HW = HW (String, String)
44 deriving (Eq, Ord)
45
46 instance Show HW where
47 show (HW (os, arch)) = arch ++ os
48
49 read_hw :: String -> HW
50 read_hw hw =
51 let (arch, os) = break (== '-') hw
52 in HW (os, arch)
53
54 data Keywords = Keywords (M.Map HW Mark)
55 deriving Eq
56
57 instance Show Keywords where
58 show (Keywords m) = intercalate " " $ map (\(hw, mark) -> show mark ++ show hw) $ M.toList m
59
60 read_kws :: String -> Keywords
61 read_kws = Keywords . M.fromList . map read_arch . words
62
63 read_arch :: String -> (HW, Mark)
64 read_arch ('-':kw) = (read_hw kw, Masked)
65 read_arch ('~':kw) = (read_hw kw, Keyworded)
66 read_arch kw = (read_hw kw, Stable)
67
68 data Ebuild = Ebuild { before_keywords :: String
69 , keywords :: Keywords
70 , after_keywords :: String
71 }
72
73 ltrim :: String -> String
74 ltrim = dropWhile isSpace
75
1ad230f @trofi improve erro messages when KEYWORDS field is not found or there is too m...
trofi authored
76 parse_ebuild :: String -> String -> Ebuild
77 parse_ebuild ebuild_path s_ebuild =
993967c @trofi initial commit
trofi authored
78 let lns = lines s_ebuild
79 -- TODO: nicer pattern match and errno
1ad230f @trofi improve erro messages when KEYWORDS field is not found or there is too m...
trofi authored
80 kw_lineno = case (findIndices (isPrefixOf "KEYWORDS" . ltrim) lns) of
81 [kw_ln] -> kw_ln
82 other -> error $ ebuild_path ++ ": parse_ebuild: strange KEYWORDS lines: " ++ show other
993967c @trofi initial commit
trofi authored
83 pre = unlines $ take kw_lineno lns
84 post = unlines $ drop (succ kw_lineno) lns
85 kw_line = lns !! kw_lineno
86 (pre_q1, q1) = break (== '"') kw_line
87 (kw, post_q1) = break (== '"') (tail q1)
88
89 in Ebuild { before_keywords = pre ++ pre_q1 ++ "\""
90 , keywords = read_kws kw
91 , after_keywords = post_q1 ++ "\n" ++ post
92 }
93
94 show_ebuild :: Ebuild -> String
95 show_ebuild e = before_keywords e ++ show (keywords e) ++ after_keywords e
96
97 update_keywords :: Keywords -> Keywords -> Keywords
98 update_keywords (Keywords from) (Keywords to) =
99 Keywords $ M.unionWith max from to
100
a903633 @trofi optimized directory traversal (stop ASAP on tree mismatch)
trofi authored
101 fetch_intersecting_ebuilds :: (FilePath, FilePath) -> FilePath -> IO [FilePath]
102 fetch_intersecting_ebuilds roots@(from_root_path,to_root_path) rel_path =
103 do let from_full_path = from_root_path </> rel_path
104 to_full_path = to_root_path </> rel_path
105
106 is_ebuild = reverse ".ebuild" `isPrefixOf` reverse rel_path
107
108 yet_dest <- fileExist to_full_path
109
110 if yet_dest
111 then do from_status <- getFileStatus from_full_path
112 to_status <- getFileStatus to_full_path
113 let are_files = isRegularFile from_status && isRegularFile to_status
114 are_dirs = isDirectory from_status && isDirectory to_status
115
116 case () of
117 _ | are_files && is_ebuild -> return [rel_path]
118 _ | are_dirs -> do dir_entries <- sort . filter (`notElem` [".", "..", "_darcs", "CVS", "files", ".git"]) <$>
119 getDirectoryContents from_full_path
120 sub_entries <- mapM (fetch_intersecting_ebuilds roots . (rel_path </>)) dir_entries
121 return $ concat sub_entries
122 _ -> return []
123 else return []
993967c @trofi initial commit
trofi authored
124
125 main :: IO ()
126 main = do
127 args <- getArgs
128 (from_tree, to_tree, pretend) <-
129 case args of
130 ["-p",from,to] -> return (from, to, True)
131 [from,to] -> return (from, to, False)
132 _ -> usage >> undefined
133 debug $ concat ["Syncing keywords from ", from_tree, " to ", to_tree, if pretend then " [dry run]" else "" ]
134
a903633 @trofi optimized directory traversal (stop ASAP on tree mismatch)
trofi authored
135 intersecting_ebuilds <- fetch_intersecting_ebuilds (from_tree,to_tree) []
993967c @trofi initial commit
trofi authored
136
137 debug $ concat ["Pulled ", show (length intersecting_ebuilds), " ebuild(s) for consideration"]
138
139 forM_ intersecting_ebuilds $ \rel_path ->
140 let from_ebuild = from_tree </> rel_path
141 to_ebuild = to_tree </> rel_path
1ad230f @trofi improve erro messages when KEYWORDS field is not found or there is too m...
trofi authored
142 in do from_e <- parse_ebuild from_ebuild <$> readFile from_ebuild
143 to_e <- parse_ebuild to_ebuild <$> readFile to_ebuild
993967c @trofi initial commit
trofi authored
144 let new_keywords = update_keywords (keywords from_e) (keywords to_e)
145 res_e = to_e { keywords = new_keywords }
146 when (keywords from_e /= keywords to_e) $
147 do info $ concat [to_ebuild, ":\n"
148 , " from: ", show (keywords from_e), "\n"
149 , " to: ", show (keywords to_e)]
150 when (new_keywords /= keywords to_e) $
151 do info $ concat [ " new: ", show (keywords res_e)]
152 when (not pretend) $
153 writeFile to_ebuild (show_ebuild res_e)
Something went wrong with that request. Please try again.