cabal-meta (empty) → 0.1
raw patch · 6 files changed
+337/−0 lines, 6 filesdep +HUnitdep +basedep +hspecsetup-changed
Dependencies added: HUnit, base, hspec, shelly, system-filepath, text, unix
Files
- CabalMeta.hs +158/−0
- LICENSE +25/−0
- Setup.hs +2/−0
- cabal-meta.cabal +54/−0
- main.hs +78/−0
- test/main.hs +20/−0
+ CabalMeta.hs view
@@ -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)
+ LICENSE view
@@ -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.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ cabal-meta.cabal view
@@ -0,0 +1,54 @@+name: cabal-meta+version: 0.1+license: BSD3+license-file: LICENSE+author: Greg Weber <greg@gregweber.info>+maintainer: Greg Weber <greg@gregweber.info>+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 +
+ main.hs view
@@ -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
+ test/main.hs view
@@ -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"]