packages feed

cabal-nirvana (empty) → 0.1

raw patch · 5 files changed

+216/−0 lines, 5 filesdep +Cabaldep +HTTPdep +basesetup-changed

Dependencies added: Cabal, HTTP, base, containers, directory, packdeps, process, transformers

Files

+ LICENSE view
@@ -0,0 +1,26 @@+Copyright (c) 2012, Michael Snoyman++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ cabal-nirvana.cabal view
@@ -0,0 +1,33 @@+Name:                cabal-nirvana+Version:             0.1+Synopsis:            Avoid Cabal dependency hell by constraining to known good versions.+Description:         This tool takes a list of known compatible versions of libraries and forces them to be used, via constraints in your cabal config file. This should bypass a lot of cabal dependency hell, thereby inducing nirvana.+Homepage:            http://github.com/snoyberg/cabal-nirvana+License:             BSD3+License-file:        LICENSE+Author:              Michael Snoyman+Maintainer:          michael@snoyman.com+Category:            Distribution+Build-type:          Simple+Cabal-version:       >=1.2++flag generate+    default: False++Executable cabal-nirvana+  Main-is:             cabal-nirvana.hs+  Build-depends:       base < 5+                     , HTTP+                     , process+                     , directory++Executable cabal-nirvana-generate+  Main-is:             generate.hs+  if flag(generate)+    Buildable: True+  else+    Buildable: False+  Build-depends:       Cabal+                     , containers+                     , transformers+                     , packdeps >= 0.3 && < 0.4
+ cabal-nirvana.hs view
@@ -0,0 +1,111 @@+import System.Environment (getArgs)+import System.Directory (getAppUserDataDirectory)+import Control.Applicative ((<$>))+import Data.Maybe (catMaybes)+import Data.Char (isSpace)+import Data.List (isPrefixOf, foldl')+import System.Exit (exitWith)+import System.Cmd (rawSystem)+import Network.HTTP (simpleHTTP, getRequest, getResponseBody)++configFile :: IO FilePath+configFile = do+    dir <- getAppUserDataDirectory "cabal"+    return $ dir ++ "/config"++nirvanaFile :: IO FilePath+nirvanaFile = do+    dir <- getAppUserDataDirectory "cabal-nirvana"+    return $ dir ++ "/default"++data Package = Package+    { name :: String+    , version :: String+    }++readPackages :: FilePath -> IO [Package]+readPackages fp =+    readFile fp >>= (catMaybes <$>) . mapM parse . lines+  where+    parse s+        | all isSpace s = return Nothing+        | "--" `isPrefixOf` s = return Nothing+    parse s =+        case words s of+            [a, b] -> return $ Just $ Package a b+            _ -> error $ "Invalid nirvana line: " ++ show s++readConfigFile :: IO [String]+readConfigFile = do+    ls <- lines <$> (configFile >>= readFile)+    -- force evaluation+    if length ls > 0+        then return ls+        else return []++writeConfigFile :: [String] -> IO ()+writeConfigFile ss = configFile >>= flip writeFile (unlines ss)++main :: IO ()+main = do+    args <- getArgs+    case args of+        ("fetch":rest) -> do+            url <-+                case rest of+                    [] -> return "http://www.snoyman.com/cabal-nirvana/yesod"+                    [x] -> return x+                    _ -> error $ "Usage: cabal-nirvana fetch [URL]"+            str <- simpleHTTP (getRequest url) >>= getResponseBody+            nirvanaFile >>= flip writeFile str+        ("start":rest) -> do+            fp <-+                case rest of+                    [] -> nirvanaFile+                    [x] -> return x+                    _ -> error $ "Usage: cabal-nirvana start [package file]"+            packages <- readPackages fp+            config <- readConfigFile+            writeConfigFile $ addNirvana packages $ removeNirvana config+        ["stop"] -> do+            config <- readConfigFile+            writeConfigFile $ removeNirvana config+        ("test":rest) -> do+            fp <-+                case rest of+                    [] -> nirvanaFile+                    [x] -> return x+                    _ -> error $ "Usage: cabal-nirvana test [package file]"+            packages <- readPackages fp+            let ws = map (\(Package n v) -> concat [n, "-", v]) packages+            putStrLn $ "cabal-dev install " ++ unwords ws+            ec <- rawSystem "cabal-dev" $ "install" : ws+            exitWith ec+        _ -> do+            putStrLn "Available commands:"+            putStrLn "    cabal-nirvana fetch [URL]"+            putStrLn "    cabal-nirvana start [package file]"+            putStrLn "    cabal-nirvana stop"+            putStrLn "    cabal-nirvana test [package file]"++beginLine, endLine :: String+beginLine = "-- cabal-nirvana begin"+endLine = "-- cabal-nirvana end"++removeNirvana :: [String] -> [String]+removeNirvana [] = []+removeNirvana (x:xs)+    | x == beginLine = removeNirvana $ drop 1 $ dropWhile (/= endLine) xs+    | otherwise = x : removeNirvana xs++addNirvana :: [Package] -> [String] -> [String]+addNirvana ps =+    (++ ss)+  where+    ss = beginLine : foldr (:) [endLine] (map toS ps)+    toS (Package n v) = concat+        [ "constraint: "+        , n+        , " == "+        , v+        ]
+ generate.hs view
@@ -0,0 +1,44 @@+import Distribution.PackDeps+import System.Environment (getArgs)+import Control.Monad.Trans.RWS+import Control.Monad.IO.Class (liftIO)+import qualified Data.Set as Set+import qualified Data.Map as Map+import Control.Monad (unless)+import System.IO (hPutStrLn, stderr)+import Distribution.Text (display)+import Distribution.Package (Dependency (..), PackageName (..))++data Package = Package+    { name :: String+    , version :: String+    }+    deriving (Eq, Ord)++type M = RWST Newest (Set.Set Package) (Set.Set String) IO++bootlibs :: Set.Set String+bootlibs = Set.fromList $ words+    "containers ghc-binary ghc-prim Cabal base old-locale old-time time random syb template-haskell filepath haskell98 unix Win32 bytestring deepseq array network process directory" -- FIXME++main :: IO ()+main = do+    toProcess <- getArgs+    newest <- loadNewest+    ((), _, packages) <- runRWST (mapM_ process toProcess) newest bootlibs+    mapM_ (\(Package n v) -> putStrLn $ unwords [n, v]) $ Set.toList packages++process :: String -> M ()+process package = do+    processed <- get+    unless (package `Set.member` processed) $ do+        put $ Set.insert package processed+        newest <- ask+        case Map.lookup package newest of+            Nothing -> liftIO $ hPutStrLn stderr $ "Warning: Unknown package: " ++ package+            Just (PackInfo version mdi _) -> do+                tell $ Set.singleton $ Package package $ display version+                case mdi of+                    Nothing -> liftIO $ hPutStrLn stderr $ "Warning: No information on: " ++ package+                    Just (DescInfo { diDeps = deps }) ->+                        mapM_ (\(Dependency (PackageName n) _) -> process n) deps