ghc-mod/scripts/bounds.hs

118 lines
3.2 KiB
Haskell
Raw Normal View History

{-# 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 ((<pkg_time) . snd) vtalist
-- Just v' = simpleParse v
return v
getVersions :: String -> 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)