diff --git a/CabalMeta.hs b/CabalMeta.hs new file mode 100644 --- /dev/null +++ b/CabalMeta.hs @@ -0,0 +1,158 @@ +{-# LANGUAGE CPP, OverloadedStrings #-} +module CabalMeta where + +import Shelly +import Prelude hiding (FilePath) +import Data.Text.Lazy (Text, unpack) +import qualified Data.Text.Lazy as T +import Filesystem.Path.CurrentOS (FilePath, hasExtension, filename) +import Data.Maybe (fromMaybe, maybeToList) +import Data.List (partition) + +#if __GLASGOW_HASKELL__ < 704 +import Data.Monoid (Monoid(..)) +import Control.Monad (when, forM) +infixr 5 <> +(<>) :: Monoid m => m -> m -> m +(<>) = mappend +#else +import Control.Monad (forM) +import Data.Monoid ((<>),Monoid(..)) +#endif + +{-- +import FileLocation (debug) +--} + +source_file :: FilePath +source_file = "sources.txt" + +data Package = Directory { + dLocation :: FilePath + , pFlags :: [Text] +} | Package { + pLocation :: Text + , pFlags :: [Text] +} | GitPackage { + gLocation :: Text + , pFlags :: [Text] + , gTag :: Maybe Text +} deriving (Show, Eq) + +asList :: Package -> [Text] +asList (Package l flags) = l:flags +asList (GitPackage l flags tag) = l : flags ++ maybeToList tag +asList (Directory d flags) = toTextUnsafe d : flags + +data PackageSources = PackageSources { + dirs :: [Package] + , hackages :: [Package] + , https :: [Package] -- also git for now + , gits :: [Package] +} deriving (Show, Eq) + +packageList :: PackageSources -> [[Text]] +packageList = map asList . packages + +packages :: PackageSources -> [Package] +packages psources = + dirs psources ++ + hackages psources ++ + gitPackages psources + +gitPackages :: PackageSources -> [Package] +gitPackages psources = + gits psources ++ https psources + +instance Monoid PackageSources where + mempty = PackageSources [] [] [] [] + mappend (PackageSources d1 ha1 ht1 g1) (PackageSources d2 ha2 ht2 g2) = + PackageSources (mappend d1 d2) (mappend ha1 ha2) + (mappend ht1 ht2) (mappend g1 g2) + +vendor_dir :: FilePath +vendor_dir = "vendor" + +git_ :: Text -> [Text] -> ShIO () +git_ = command1_ "git" [] + +readPackages :: Bool -> FilePath -> ShIO PackageSources +readPackages allowCabals startDir = do + fullDir <- path startDir + chdir fullDir $ do + cabalPresent <- if allowCabals then return False else isCabalPresent + if cabalPresent then return mempty else do + psources <- getSources + when (psources == mempty) $ terror $ "empty " <>| source_file + + let git_pkgs = gitPackages psources + child_vendor_pkgs <- if null git_pkgs then return [] else do + mkdir_p vendor_dir + chdir vendor_dir $ + forM git_pkgs $ \pkg -> do + let repo = gLocation pkg + let d = filename $ fromText repo + e <- test_d d + if not e + then git_ "clone" ["--recursive", repo] + else chdir d $ git_ "fetch" ["origin"] + chdir d $ do + git_ "checkout" [fromMaybe "master" (gTag pkg)] + git_ "submodule" ["foreach", "git", "pull", "origin", "master"] + readPackages False d + + child_dir_pkgs <- forM (dirs psources) $ \dir -> do + b <- fmap (== fullDir) (path $ dLocation dir) + if b then return mempty else readPackages False (dLocation dir) + + let child_pkgs = child_dir_pkgs ++ child_vendor_pkgs + + -- in the end we have either hackage packages or directories + -- a directory was either listed as a directory or a child found in a sources.txt in that directory + -- if there are no child, there will be an empty list [] of children + -- this would be easy to break & should be cleaned up + return $ mempty { + hackages = hackages psources ++ concatMap hackages child_pkgs + , dirs = + concatMap (\(p, ps) -> if null ps then [p] else ps) $ + zip (dirs psources ++ gits psources ++ https psources) (map dirs child_pkgs) + } + where + headMay [] = Nothing + headMay xs = Just (head xs) + + isCabalFile = flip hasExtension "cabal" + isCabalPresent = fmap (any isCabalFile) (ls ".") + + getSources :: ShIO PackageSources + getSources = do + sourceContent <- readfile source_file + let sources = paritionSources [ source | + source <- map (T.words . T.strip) (T.lines sourceContent), + not . null $ source, + "--" /= head source + ] + ds <- mapM fullPath (dirs sources) + return $ sources { dirs = ds } + where + fullPath package = do + fp <- path $ dLocation package + return package { dLocation = fp } + + paritionSources :: [[Text]] -> PackageSources + paritionSources = go mempty + where + go sources [] = sources + go _ ([]:_) = error "impossible" + go sources ((name:flags):more) = let c = T.head name in + if c == '.' || c == '/' then go sources { dirs = mkDir: dirs sources } more + else if "http" `T.isPrefixOf` name then go sources { https = mkGit: https sources } more + else if "git:" `T.isPrefixOf` name then go sources { gits = mkGit: gits sources } more + else go sources { hackages = mkPkg: hackages sources } more + where + mkDir = Directory (fromText name) flags + mkPkg = Package name flags + mkGit = let (realFlags, tags) = partition (T.isPrefixOf "-") flags in + if length tags > 1 + then error $ unpack $ "did not understand" <> T.intercalate " " (asList (Package name flags)) + else GitPackage name realFlags (headMay tags) diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,25 @@ +The following license covers this documentation, and the source code, except +where otherwise indicated. + +Copyright 2010, 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 "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 HOLDERS 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. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/cabal-meta.cabal b/cabal-meta.cabal new file mode 100644 --- /dev/null +++ b/cabal-meta.cabal @@ -0,0 +1,54 @@ +name: cabal-meta +version: 0.1 +license: BSD3 +license-file: LICENSE +author: Greg Weber +maintainer: Greg Weber +synopsis: build multiple packages at once +description: build multiple packages at once + +stability: Beta +cabal-version: >= 1.8 +build-type: Simple +homepage: http://www.yesodweb.com/ + +flag ghc7 + +Library + if flag(ghc7) + build-depends: base >= 4.3 && < 5 + cpp-options: -DGHC7 + else + build-depends: base >= 4 && < 4.3 + build-depends: shelly >= 0.3.1 + , text, system-filepath + -- , file-location + extensions: OverloadedStrings + exposed-modules: CabalMeta + +executable cabal-meta + main-is: main.hs + + if flag(ghc7) + build-depends: base >= 4.3 && < 5 + cpp-options: -DGHC7 + else + build-depends: base >= 4 && < 4.3 + build-depends: shelly >= 0.3.1 + , text, system-filepath + -- , file-location + + ghc-options: -Wall + + extensions: OverloadedStrings + +test-suite test + main-is: test/main.hs + hs-source-dirs: . + type: exitcode-stdio-1.0 + + build-depends: shelly >= 0.3.1 + , hspec, HUnit, unix, base, text, system-filepath + -- , file-location + extensions: OverloadedStrings + diff --git a/main.hs b/main.hs new file mode 100644 --- /dev/null +++ b/main.hs @@ -0,0 +1,78 @@ +{-# LANGUAGE OverloadedStrings, CPP #-} +import CabalMeta +import Shelly +import System.Environment (getArgs) + +import qualified Data.Text.Lazy as T +import Control.Monad (forM_, unless) +-- import Filesystem.Path.CurrentOS (decodeString) +import Data.Maybe (isNothing) +import Data.Text.Lazy (Text, pack) + +import Control.Monad (when) +import Filesystem.Path.CurrentOS (FilePath, filename) +import Prelude hiding (FilePath) + +headDef :: a -> [a] -> a +headDef d [] = d +headDef _ (x:_) = x + +help :: Text +help = T.intercalate "\n" [ + "cabal-meta is a cabal wrapper for packages not on hackage" + ,"run with:" + ,"" + ," cabal-meta [--dev] install [Cabal install arguments]" + ,"" + ," --dev means use cabal-dev instead of cabal" + ] + +cabal_install_ :: CabalExe -> [Text] -> ShIO () +cabal_install_ cabal = command_ (progName cabal) ["install"] + +data CabalExe = Cabal | CabalDev + +progName :: CabalExe -> FilePath +progName Cabal = "cabal" +progName CabalDev = "cabal-dev" + +main :: IO () +main = do + cmdArgs <- fmap (map pack) getArgs + shelly $ verbosely $ do + let isDev = elem "--dev" cmdArgs + noDevArgs = filter (/= "--dev") cmdArgs + cabal = if isDev then CabalDev else Cabal + + unless (headDef "" noDevArgs == "install") $ + errorExit help + + let (_:args) = noDevArgs + + packageSources <- readPackages True "." + ifCabal cabal $ + when (length (packages packageSources) == length (hackages packageSources)) $ do + mPath <- which "cabal-src-install" + when (isNothing mPath) $ + errorExit "please run: cabal install cabal-src-install" + + let installs = packageList packageSources + echo "Installing packages:" + mapM_ echo $ map (T.intercalate " ") installs + + cabal_install_ cabal $ args ++ concat installs + ifCabal cabal $ do + forM_ (dirs packageSources) $ \pkg -> + chdir (dLocation pkg) $ "cabal-src-install" # ["--src-only"] + forM_ (gitPackages packageSources) $ \pkg -> + chdir vendor_dir $ do + let repo = gLocation pkg + let d = filename $ fromText repo + chdir d $ "cabal-src-install" # ["--src-only"] + return () + + where + ifCabal cabal a = + case cabal of + CabalDev -> return () + Cabal -> a diff --git a/test/main.hs b/test/main.hs new file mode 100644 --- /dev/null +++ b/test/main.hs @@ -0,0 +1,20 @@ +{-# LANGUAGE OverloadedStrings #-} +import Shelly +import CabalMeta +import Test.Hspec.Monadic +import Test.HUnit ((@?=),(@=?), Assertion, assertFailure, assertBool) +import Test.Hspec.HUnit () +import Data.Text.Lazy () +import System.IO +import Filesystem.Path.CurrentOS hiding (fromText) + +main :: IO () +main = hspecX $ + it "gets the packages" $ do + (psources, wd) <- shelly $ verbosely $ do + ps <- readPackages True "test" + d <- pwd + return (ps, d) + + let localize = (\p-> toTextUnsafe $ wd fromText p) + concatMap asList (packages psources) @?= [localize "test/child", localize "test/vendor/yesod/yesod", "sphinx", "-fone-one-beta", "fake-package"]