depends 0.0.0 → 0.0.1

raw patch · 5 files changed

+175/−1 lines, 5 files

Files

depends.cabal +6/−1
src/Cabal.hs +38/−0
src/Config.hs +20/−0
src/GhcPkg.hs +70/−0
src/Run.hs +41/−0

depends.cabal view

@@ -1,5 +1,5 @@ name:             depends-version:          0.0.0+version:          0.0.1 license:          MIT license-file:     LICENSE copyright:        (c) 2013 Simon Hengel@@ -23,6 +23,11 @@       src   main-is:       Main.hs+  other-modules:+      GhcPkg+      Cabal+      Run+      Config   build-depends:       base    == 4.*     , process

+ src/Cabal.hs view

@@ -0,0 +1,38 @@+module Cabal where++import Data.List+import Data.Version++import GhcPkg++format :: String -> [Package] -> [Package] -> String+format name mainDeps testDeps = unlines [+    "-- NOTE:"+  , "--"+  , "-- This file was generated from dependencies.yaml.  To regenerate it run"+  , "-- `depends`."+  , "--"+  , "name: " ++ name+  , "version: 0.0.0"+  , "build-type: Simple"+  , "cabal-version: >= 1.8"+  , ""+  , "executable " ++ name+  , "  ghc-options: -Wall"+  , "  hs-source-dirs: src"+  , "  main-is: Main.hs"+  ] ++ builDepends mainDeps ++ unlines [+    ""+  , "test-suite test"+  , "  type: exitcode-stdio-1.0"+  , "  ghc-options: -Wall -Werror"+  , "  hs-source-dirs: test, src"+  , "  main-is: Main.hs"+  ] ++ builDepends testDeps+  where+    builDepends deps+      | null deps = ""+      | otherwise = "  build-depends:\n      " ++ intercalate "\n    , " (map formatDep deps) ++ "\n"++    formatDep :: Package -> String+    formatDep (Package n v) = n ++ " == " ++ showVersion v

+ src/Config.hs view

@@ -0,0 +1,20 @@+{-# LANGUAGE OverloadedStrings #-}+module Config where++import           Control.Applicative+import           Data.Maybe+import           System.Directory+import           System.FilePath+import qualified Data.Yaml.Config as Yaml++type Config = (String, [String], [String])++load :: FilePath -> IO Config+load path = do+  yaml <- Yaml.load path+  dir <- listToMaybe . reverse . splitDirectories <$> getCurrentDirectory+  let name = fromMaybe "dependencies" $ Yaml.lookup "name" yaml <|> dir+      deps sec = fromMaybe [] (Yaml.lookup sec yaml)+      mainDeps = deps "main"+      testDeps = deps "test"+  return (name, mainDeps, testDeps)

+ src/GhcPkg.hs view

@@ -0,0 +1,70 @@+module GhcPkg where++import           Control.Applicative+import           Control.Monad+import           Data.Char+import           Data.Maybe+import qualified Data.Version as Version+import           Data.Version hiding (parseVersion)+import           Text.ParserCombinators.ReadP+import           System.Process+import           System.Exit+import           System.IO+import           System.Environment++data Package = Package {+  packageName :: String+, packageVersion :: Version+} deriving (Eq, Show, Ord)++dependencies :: Package -> IO [Package]+dependencies p = do +  r <- uncurry readProcess c ""+  let err = die ("Could not parse the output of `" ++ showCommand c ++ "`!")+  maybe err return (parseDependencies r)+  where+    c = ("ghc-pkg", ["field", showPackage p, "depends"])+    showCommand = unwords . uncurry (:)++parseDependencies :: String -> Maybe [Package]+parseDependencies xs = case xs of+  'd':'e':'p':'e':'n':'d':'s':':':ys ->+    mapM (stripPackageFingerprint >=> parsePackage) (dropBoring ys)+  _ -> Nothing+  where+    dropBoring = filter (/= "builtin_rts") . map strip . lines++stripPackageFingerprint :: String -> Maybe String+stripPackageFingerprint xs = case (dropWhile (/= '-') . reverse) xs of+  '-':ys -> (Just . reverse) ys+  _ -> Nothing++latest :: String -> IO Package+latest name = do+  p <- strip <$> readProcess "ghc-pkg" ["latest", name] ""+  let err = die (show p ++ " is not a valid package name!")+  maybe err return (parsePackage p)++parsePackage :: String -> Maybe Package+parsePackage xs = do+  (name, version) <- splitVersion xs+  Package name <$> parseVersion version+  where+    splitVersion ys = case (break (== '-') . reverse) ys of+      (version, '-' : name) -> Just (reverse name, reverse version)+      _ -> Nothing++showPackage :: Package -> String+showPackage (Package name version) = name ++ "-" ++ showVersion version++parseVersion :: String -> Maybe Version+parseVersion = fmap fst . listToMaybe . filter ((== "") . snd) . readP_to_S Version.parseVersion++strip :: String -> String+strip = dropWhile isSpace . reverse . dropWhile isSpace . reverse++die :: String -> IO a+die err = do+  name <- getProgName+  hPutStrLn stderr (name ++ ": " ++ err)+  exitFailure

+ src/Run.hs view

@@ -0,0 +1,41 @@+module Run (run) where++import           Control.Applicative+import           Data.List+import           Data.Char+import           Data.Ord+import           Data.Map (Map)+import qualified Data.Map as Map+import           Control.Monad.Trans.State+import           Control.Monad.IO.Class++import           Config+import           GhcPkg+import qualified Cabal++type Cache = Map Package [Package]++run :: IO ()+run = do+  (name, mainDeps, testDeps) <- load "dependencies.yaml"+  mainPackages <- mapM latest mainDeps+  testPackages <- mapM latest testDeps+  m <- execStateT (mapM_ transitiveDependencies mainPackages) Map.empty+  t <- execStateT (mapM_ transitiveDependencies testPackages) m+  writeFile (name ++ ".cabal") (Cabal.format name (keys m) (keys t))+  where+    keys = sortByPackageName . Map.keys+    sortByPackageName :: [Package] -> [Package]+    sortByPackageName = sortBy (comparing (map toLower . packageName))++transitiveDependencies :: Package -> StateT Cache IO [Package]+transitiveDependencies p = do+  c <- get+  case Map.lookup p c of+    Just xs -> return xs+    Nothing -> do+      xs <- liftIO (dependencies p)+      ys <- concat <$> mapM transitiveDependencies xs+      let r = p : xs ++ ys+      modify (Map.insert p r)+      return r