Created
September 16, 2010 03:47
-
-
Save naota/581933 to your computer and use it in GitHub Desktop.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
import Data.Map (empty, elems, insertWithKey, insert, keys, lookup) | |
import System.Directory (getDirectoryContents) | |
import Data.List (isSuffixOf, isPrefixOf, sort, union) | |
import Text.ParserCombinators.Parsec | |
import Prelude hiding (lookup) | |
import Data.Maybe (fromJust) | |
data Ebuild = Ebuild { version :: Int | |
, revision :: Int | |
, packageName :: String | |
, patchVersion :: Maybe Int | |
} | |
deriving (Show, Ord, Eq) | |
main :: IO () | |
main = do | |
g <- getDirectoryContents gentooSourcePath | |
c <- getDirectoryContents ccsSouecePath | |
let gentooFiles = filter isEbuild g | |
ccsFiles = filter isEbuild c | |
gg <- mapM fillPatchVersion . updatedEbuilds $ map str2ebuild gentooFiles | |
cc <- mapM (fillPatchVersion . str2ebuild) ccsFiles | |
mapM_ putStrLn $ sort $ cmpEbuildsPatchVersion cc gg | |
where isEbuild = isSuffixOf ".ebuild" | |
ccsSouecePath :: FilePath | |
ccsSouecePath = "." | |
gentooSourcePath :: FilePath | |
gentooSourcePath = "/usr/portage/sys-kernel/gentoo-sources" | |
ebuildName :: Parser Ebuild | |
ebuildName = do { n <- (string "ccs-" <|> string "gentoo-") | |
; string "sources-2.6." | |
; ver <- many digit | |
; rev <- option 0 ebuildRevision | |
; string ".ebuild" | |
; eof | |
; return Ebuild { packageName = n ++ "sources" | |
, version = read ver | |
, revision = rev | |
, patchVersion = Nothing | |
} | |
} | |
ebuildRevision :: Parser Int | |
ebuildRevision = do { string "-r" | |
; revnum <- many digit | |
; return $ read revnum | |
} | |
str2ebuild :: String -> Ebuild | |
str2ebuild str = case parse ebuildName "" str of | |
Left e -> error $ show e | |
Right x -> x | |
ebuildFileName :: Ebuild -> String | |
ebuildFileName x = packageName x ++ "-2.6." ++ (show $ version x) ++ rev ++ ".ebuild" | |
where rev = if revision x == 0 | |
then "" | |
else "-r" ++ (show $ revision x) | |
updatedEbuilds :: [Ebuild] -> [Ebuild] | |
updatedEbuilds ebuilds = scan empty ebuilds | |
where scan m [] = elems m | |
scan m (e:es) = let v = version e | |
f _ ne oe = if revision ne > revision oe | |
then ne | |
else oe | |
newm = insertWithKey f v e m | |
in scan newm es | |
fillPatchVersion :: Ebuild -> IO Ebuild | |
fillPatchVersion e = do | |
let dir = if "ccs-" `isPrefixOf` packageName e | |
then ccsSouecePath | |
else gentooSourcePath | |
filename = ebuildFileName e | |
file = dir ++ "/" ++ filename | |
genpatch [] = error "no GENPATCH line." | |
genpatch (x:xs) = case parse genpatchVersioLine "" x of | |
Left _ -> genpatch xs | |
Right pv -> e {patchVersion = Just pv} | |
content <- readFile file | |
return . genpatch $ lines content | |
genpatchVersioLine :: Parser Int | |
genpatchVersioLine = do { string "K_GENPATCHES_VER=\"" | |
; v <- many digit | |
; char '"' | |
; eof | |
; return $ read v | |
} | |
cmpEbuildsPatchVersion :: [Ebuild] -> [Ebuild] -> [String] | |
cmpEbuildsPatchVersion ccs gentoo = map f versions | |
where f v = let ccsv = lookup v ccsmap | |
genv = lookup v genmap | |
state = case (ccsv, genv) of | |
(Nothing, Nothing) -> error "Something Wrong" | |
(Just _, Nothing) -> "to be REMOVED" | |
(Nothing, Just g) -> "to be ADDED genpatch " ++ | |
show (fromJust $ patchVersion g) | |
(Just c, Just g) -> let cv = fromJust $ patchVersion c | |
gv = fromJust $ patchVersion g | |
in if cv == gv | |
then "nothing to do" | |
else "to be UPDATED to use genpatch " ++ show gv | |
in "2.6." ++ show v ++ ": " ++ state | |
ccsmap = foldl insebuild empty ccs | |
genmap = foldl insebuild empty gentoo | |
m `insebuild` e = insert (version e) e m | |
versions = union (keys ccsmap) (keys genmap) |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment