From 3bb2e26b4d8f3258abfce05d941b24b938e48a79 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Daniel=20Gr=C3=B6ber?= Date: Sun, 30 Oct 2016 22:45:44 +0100 Subject: [PATCH] hackage-meta: some scripts for filling out missing bounds --- scripts/bounds.hs | 117 ++++++++++++++++++++++++++++++++++ scripts/diff.hs | 11 ++++ scripts/edit-bounds-macros.el | 16 +++++ scripts/extract-build-deps.hs | 13 ++++ 4 files changed, 157 insertions(+) create mode 100644 scripts/bounds.hs create mode 100644 scripts/diff.hs create mode 100644 scripts/edit-bounds-macros.el create mode 100644 scripts/extract-build-deps.hs diff --git a/scripts/bounds.hs b/scripts/bounds.hs new file mode 100644 index 0000000..2af5d62 --- /dev/null +++ b/scripts/bounds.hs @@ -0,0 +1,117 @@ +{-# LANGUAGE LambdaCase #-} +import Control.Arrow +import Data.List +import Data.List.Split +import Data.Maybe +import Data.Function +import Data.Map (Map) +import qualified Data.Map as M +import System.Environment +import System.FilePath +import System.Directory + +import Distribution.Verbosity +import Distribution.PackageDescription.Parse (readPackageDescription) +import Distribution.PackageDescription.Configuration (flattenPackageDescription) +import Distribution.PackageDescription +import Distribution.Package +import Distribution.Version +import Distribution.Text +import Text.PrettyPrint +import System.Environment + + +datadir = "hackage-metadata" + +main = do + [pkg,v] <- getArgs + + let pkg_id = pkg ++ "-" ++ v + cabal_file = datadir pkg_id <.> "cabal" + + pkg_time <- getTime pkg v + + ps <- + mapMaybe (\case (p, "-any") -> Just p + _ -> Nothing) + + <$> getDeps cabal_file + vs <- mapM (getClosestVersion pkg_time) ps + print $ ps `zip` vs + return () + +check :: VersionRange -> Version -> Bool +check vr v = withinRange v vr + +getClosestVersion :: Integer -> String -> IO String +getClosestVersion pkg_time dep = do + vs <- getVersions dep + ts <- mapM (getTime dep) vs + let vtalist = sortBy (flip compare `on` snd) $ vs `zip` ts + ((v,_t):_) = filter (( IO [String] +getVersions p = do + fs <- listDirectory datadir + return $ nub + $ map snd + $ filter ((==p) . fst) + $ map (parsePkgId . dropExtension) + $ filter (p `isPrefixOf`) fs + +getTime :: String -> String -> IO Integer +getTime p v = do + let pkg_id = p ++ "-" ++ v + file = datadir pkg_id <.> "upload-date" + read <$> readFile file + +getDeps f = do + pd <- flattenPackageDescription <$> readPackageDescription silent f + return $ --nubBy ((==) `on` fst) $ + [ (unPackageName n, (render . disp) v) + | (Dependency n v) <- buildDepends pd + , not $ unPackageName n `elem` [ + "ghc-mod", + "ghc", + "array", + "base", + "bin-package-db", + "binary", + "bytestring", + "containers", + "deepseq", + "directory", + "filepath", + "ghc-binary", + "ghc-boot", + "ghc-boot-th", + "ghc-prim", + "ghci", + "haskelline", + "haskell2010", + "haskell98", + "haskell98", + "hoopl", + "hpc", + "integer-gmp", + "old-locale", + "old-time", + "pretty", + "process", + "random", + "rts", + "template-haskell", + "terminfo", + "time", + "transformers", + "unix", + "xhtml" + ] + ] + +parsePkgId pkg_id = let + v:pkgcs = reverse $ splitOn "-" pkg_id + in + (intercalate "-" $ reverse pkgcs, v) diff --git a/scripts/diff.hs b/scripts/diff.hs new file mode 100644 index 0000000..8619470 --- /dev/null +++ b/scripts/diff.hs @@ -0,0 +1,11 @@ +import Data.Tuple +import System.FilePath +import System.Environment +import System.Process + +main = do + vs <- lines <$> getContents + [pkg, dir] <- getArgs + mapM_ system $ map (\(v1, v2) -> "diff -u --color=always " ++ file pkg dir v1 ++ " " ++ file pkg dir v2 ++ "; echo; echo; echo") $ map swap $ drop 1 vs `zip` vs + where + file pkg dir v = dir (pkg ++ "-" ++ v) <.> "cabal" diff --git a/scripts/edit-bounds-macros.el b/scripts/edit-bounds-macros.el new file mode 100644 index 0000000..854a609 --- /dev/null +++ b/scripts/edit-bounds-macros.el @@ -0,0 +1,16 @@ + +(fset 'goto-lib-dep + (lambda (&optional arg) "Keyboard macro." (interactive "p") (kmacro-exec-ring-item (quote ([134217788 21 19 94 108 105 98 114 97 114 121 13 19 98 117 105 108 100 45 100 101 112 101 110 100 115 58 13 19 44 32 25 13 18 44 13 6 6] 0 "%d")) arg))) + + +(fset 'copy-dep-name + (lambda (&optional arg) "Keyboard macro." (interactive "p") (kmacro-exec-ring-item (quote ([1 19 44 32 return 67108896 134217830 134217847 24 24 67108896 67108896] 0 "%d")) arg))) + +(fset 'replace-with-lib-dep + [?\C-a ?\M-x ?c ?o ?p ?y ?- ?d ?e ?p ?- ?n ?a ?m ?e ?\C-m ?\C-x ?r ? ?r ?\M-x ?g ?o ?t ?o ?- ?l ?i ?b ?- ?d ?e ?p ?\C-m ?\C- ?\C-e ?\M-w ?\C-x ?r ?j ?r ?\C-y ?\C-k ?\C-x ?\C-x ?\C- ?\C- ]) + +(fset 'yank-kill-replace + [?\C- ?\C- ?\C-y ?\C-k ?\C-x ?\C-x ?\M-w]) + +(global-set-key (kbd "C-c C-r") 'replace-with-lib-dep) +(global-set-key (kbd "C-c C-k") 'yank-kill-replace) diff --git a/scripts/extract-build-deps.hs b/scripts/extract-build-deps.hs new file mode 100644 index 0000000..d6a4164 --- /dev/null +++ b/scripts/extract-build-deps.hs @@ -0,0 +1,13 @@ +import Distribution.Verbosity +import Distribution.PackageDescription.Parse (readPackageDescription) +import Distribution.PackageDescription.Configuration (flattenPackageDescription) +import Distribution.PackageDescription +import Distribution.Package +import Distribution.Text +import Text.PrettyPrint +import System.Environment + +main = do + [f] <- getArgs + pd <- flattenPackageDescription <$> readPackageDescription silent f + mapM_ putStrLn $ map (\(Dependency n v) -> unPackageName n ++ "\t" ++ render (disp v)) $ buildDepends pd