118 lines
3.2 KiB
Haskell
118 lines
3.2 KiB
Haskell
{-# 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)
|