Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
tree: 0382ae7866
Fetching contributors…

Cannot retrieve contributors at this time

file 153 lines (123 sloc) 5.662 kb
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 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153
module Main ( main ) where

import Control.Applicative ((<$>))
import Control.Monad (forM_, when)

import Data.Char (isSpace)
import Data.List (findIndices, intercalate, isPrefixOf, sort)
import qualified Data.Map as M

import System.Directory (getDirectoryContents)
import System.FilePath ((</>))
import System.Posix.Files (fileExist, getFileStatus, isDirectory, isRegularFile)
import System.Environment (getArgs)
import System.Exit (exitWith, ExitCode(..))

usage :: IO ()
usage =
    do putStrLn "usage: syn-kw [-p] <from-tree> <to-tree>"
       exitWith (ExitFailure 1)

debug :: String -> IO ()
debug str =
    do putStrLn str
       return ()

info :: String -> IO ()
info str =
    do putStrLn str
       return ()

-- We rely on sort order here
data Mark = Masked
          | Keyworded
          | Stable
     deriving (Eq, Ord)

instance Show Mark where
    show Masked = "-"
    show Keyworded = "~"
    show Stable = ""

-- We rely on sort order here
data HW = HW (String, String)
    deriving (Eq, Ord)

instance Show HW where
    show (HW (os, arch)) = arch ++ os

read_hw :: String -> HW
read_hw hw =
    let (arch, os) = break (== '-') hw
    in HW (os, arch)

data Keywords = Keywords (M.Map HW Mark)
    deriving Eq

instance Show Keywords where
    show (Keywords m) = intercalate " " $ map (\(hw, mark) -> show mark ++ show hw) $ M.toList m

read_kws :: String -> Keywords
read_kws = Keywords . M.fromList . map read_arch . words

read_arch :: String -> (HW, Mark)
read_arch ('-':kw) = (read_hw kw, Masked)
read_arch ('~':kw) = (read_hw kw, Keyworded)
read_arch kw = (read_hw kw, Stable)

data Ebuild = Ebuild { before_keywords :: String
                     , keywords :: Keywords
                     , after_keywords :: String
                     }

ltrim :: String -> String
ltrim = dropWhile isSpace

parse_ebuild :: String -> String -> Ebuild
parse_ebuild ebuild_path s_ebuild =
    let lns = lines s_ebuild
        -- TODO: nicer pattern match and errno
        kw_lineno = case (findIndices (isPrefixOf "KEYWORDS" . ltrim) lns) of
                        [kw_ln] -> kw_ln
                        other -> error $ ebuild_path ++ ": parse_ebuild: strange KEYWORDS lines: " ++ show other
        pre = unlines $ take kw_lineno lns
        post = unlines $ drop (succ kw_lineno) lns
        kw_line = lns !! kw_lineno
        (pre_q1, q1) = break (== '"') kw_line
(kw, post_q1) = break (== '"') (tail q1)

    in Ebuild { before_keywords = pre ++ pre_q1 ++ "\""
               , keywords = read_kws kw
               , after_keywords = post_q1 ++ "\n" ++ post
               }

show_ebuild :: Ebuild -> String
show_ebuild e = before_keywords e ++ show (keywords e) ++ after_keywords e

update_keywords :: Keywords -> Keywords -> Keywords
update_keywords (Keywords from) (Keywords to) =
    Keywords $ M.unionWith max from to

fetch_intersecting_ebuilds :: (FilePath, FilePath) -> FilePath -> IO [FilePath]
fetch_intersecting_ebuilds roots@(from_root_path,to_root_path) rel_path =
    do let from_full_path = from_root_path </> rel_path
           to_full_path = to_root_path </> rel_path

           is_ebuild = reverse ".ebuild" `isPrefixOf` reverse rel_path

       yet_dest <- fileExist to_full_path

       if yet_dest
          then do from_status <- getFileStatus from_full_path
                  to_status <- getFileStatus to_full_path
                  let are_files = isRegularFile from_status && isRegularFile to_status
                      are_dirs = isDirectory from_status && isDirectory to_status

                  case () of
                      _ | are_files && is_ebuild -> return [rel_path]
                      _ | are_dirs -> do dir_entries <- sort . filter (`notElem` [".", "..", "_darcs", "CVS", "files", ".git"]) <$>
                                                            getDirectoryContents from_full_path
                                         sub_entries <- mapM (fetch_intersecting_ebuilds roots . (rel_path </>)) dir_entries
                                         return $ concat sub_entries
                      _ -> return []
          else return []

main :: IO ()
main = do
    args <- getArgs
    (from_tree, to_tree, pretend) <-
        case args of
            ["-p",from,to] -> return (from, to, True)
            [from,to] -> return (from, to, False)
            _ -> usage >> undefined
    debug $ concat ["Syncing keywords from ", from_tree, " to ", to_tree, if pretend then " [dry run]" else "" ]

    intersecting_ebuilds <- fetch_intersecting_ebuilds (from_tree,to_tree) []

    debug $ concat ["Pulled ", show (length intersecting_ebuilds), " ebuild(s) for consideration"]

    forM_ intersecting_ebuilds $ \rel_path ->
        let from_ebuild = from_tree </> rel_path
            to_ebuild = to_tree </> rel_path
        in do from_e <- parse_ebuild from_ebuild <$> readFile from_ebuild
              to_e <- parse_ebuild to_ebuild <$> readFile to_ebuild
              let new_keywords = update_keywords (keywords from_e) (keywords to_e)
                  res_e = to_e { keywords = new_keywords }
              when (keywords from_e /= keywords to_e) $
                  do info $ concat [to_ebuild, ":\n"
                                   , " from: ", show (keywords from_e), "\n"
                                   , " to: ", show (keywords to_e)]
              when (new_keywords /= keywords to_e) $
                  do info $ concat [ " new: ", show (keywords res_e)]
                     when (not pretend) $
                         writeFile to_ebuild (show_ebuild res_e)
Something went wrong with that request. Please try again.