cabal-meta 0.2.3.2 → 0.3

raw patch · 3 files changed

+72/−25 lines, 3 filesdep −HUnitdep ~hspecPVP ok

version bump matches the API change (PVP)

Dependencies removed: HUnit

Dependency ranges changed: hspec

API changes (from Hackage documentation)

Files

• CabalMeta.hs +68/−19
• cabal-meta.cabal +2/−2
• test/main.hs +2/−4

@@ -1,11 +1,18 @@ {-# LANGUAGE CPP, OverloadedStrings #-}-module CabalMeta where+module CabalMeta (+    Package (..)+  , PackageSources (..)+  , readPackages+  , packageList+  , vendor_dir+  , gitPackages+  ) where  import Shelly hiding (tag) import Prelude hiding (FilePath) import Data.Text.Lazy (Text, unpack) import qualified Data.Text.Lazy as T-import Filesystem.Path.CurrentOS (hasExtension, filename)+import Filesystem.Path.CurrentOS (hasExtension, basename) import Data.Maybe (fromMaybe, maybeToList) import Data.List (partition) @@ -37,22 +44,34 @@     gitLocation :: Text   , pFlags :: [Text]   , gTag :: Maybe Text+} | DarcsPackage {+    darcsLocation :: Text+  , pFlags :: [Text]+  , darcsTag :: Maybe Text } deriving (Show, Eq)  asList :: Package -> [Text] asList (Package l flags) = l:flags asList (GitPackage l flags tag) = l : flags ++ maybeToList tag+asList (DarcsPackage l flags tag) = l : flags ++ maybeToList tag asList (Directory d flags) = toTextIgnore d : flags +asInstallList :: Package -> [Text]+asInstallList (Package l flags) = l:flags+asInstallList (GitPackage l flags _tag) = urlToDiskPath l : flags+asInstallList (DarcsPackage l flags _tag) = urlToDiskPath l : flags+asInstallList (Directory d flags) = toTextIgnore d : flags+ data PackageSources = PackageSources {     dirs     :: [Package]   , hackages :: [Package]   , https    :: [Package] -- also git for now    , gits     :: [Package]+  , darcsen  :: [Package] } deriving (Show, Eq)  packageList :: PackageSources -> [[Text]]-packageList = map asList . packages+packageList = map asInstallList . packages  packages :: PackageSources -> [Package] packages psources =@@ -65,17 +84,25 @@   gits psources ++ https psources  instance Monoid PackageSources where-  mempty = PackageSources [] [] [] []-  mappend (PackageSources d1 ha1 ht1 g1) (PackageSources d2 ha2 ht2 g2) =+  mempty = PackageSources [] [] [] [] []+  mappend (PackageSources d1 ha1 ht1 g1 da1) (PackageSources d2 ha2 ht2 g2 da2) =     PackageSources (mappend d1 d2) (mappend ha1 ha2)-      (mappend ht1 ht2) (mappend g1 g2)+      (mappend ht1 ht2) (mappend g1 g2) (mappend da1 da2)  vendor_dir :: FilePath vendor_dir = "vendor" +-- | Translate a remote repository location to the on-disk location we+--   fetched it to+urlToDiskPath :: Text -> Text+urlToDiskPath x = toTextIgnore $ vendor_dir </> basename (fromText x)+ git_ :: Text -> [Text] -> ShIO () git_ = command1_ "git" [] +darcs_ :: Text -> [Text] -> ShIO ()+darcs_ = command1_ "darcs" []+ readPackages :: Bool ->  FilePath -> ShIO PackageSources readPackages allowCabals startDir = do   fullDir <- canonic startDir@@ -85,13 +112,14 @@         psources <- getSources         when (psources == mempty) $ terror $ "empty " <> toTextIgnore source_file -        let git_pkgs = gitPackages psources+        let git_pkgs   = gitPackages psources+            darcs_pkgs = darcsen psources         child_vendor_pkgs <- if null git_pkgs then return [] else do           mkdir_p vendor_dir-          chdir vendor_dir $-            forM git_pkgs $ \pkg -> do+          chdir vendor_dir $ do+            gkids <- forM git_pkgs $ \pkg -> do               let repo = gitLocation pkg -              let d = filename $ fromText repo+              let d = basename $ fromText repo               e <- test_d d               if not e                 then git_ "clone" ["--recursive", repo]@@ -100,7 +128,18 @@                 git_ "checkout" [fromMaybe "master" (gTag pkg)]                 git_ "submodule" ["foreach", "git", "pull", "origin", "master"]               readPackages False d-+            dkids <- forM darcs_pkgs $ \pkg -> do+              let repo   = darcsLocation pkg+                  tflags = case darcsTag pkg of+                             Nothing -> []+                             Just t  -> ["--tag", t]+              let d = basename $ fromText repo+              e <- test_d d+              if not e+                then darcs_ "get" $ ["--lazy", repo] ++ tflags+                else chdir d $ darcs_ "pull"  ["--all"]+              readPackages False d+            return (gkids ++ dkids)         child_dir_pkgs <- forM (dirs psources) $ \dir -> do           b <- fmap (== fullDir) (canonic $ dLocation dir)           if b then return mempty else readPackages False (dLocation dir)@@ -115,7 +154,8 @@             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)+                zip (dirs psources ++ gits psources ++ https psources ++ darcsen psources)+                    (map dirs child_pkgs)           }   where     headMay [] = Nothing@@ -145,15 +185,24 @@           go sources [] = sources           go _ ([]:_) = error "impossible"           go sources ((name:flags):more) = let n = T.head name in-            if n == '.' || n == '/'               then go sources { dirs     = mkDir: dirs sources } more-              else if "http"  `T.isPrefixOf` name then go sources { https    = mkGit: https sources } more-              else if "https" `T.isPrefixOf` name then go sources { gits     = 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+            case () of+              _ | n `elem` "./"   -> next sources { dirs     = mkDir: dirs sources  }+                | prefix "http"   -> next sources { https    = mkGit: https sources }+                | prefix "https"  -> next sources { gits     = mkGit: https sources }+                | prefix "git:"   -> next sources { gits     = mkGit: gits sources  }+                | prefix "darcs:" -> next sources { darcsen  = mkDarcs: darcsen sources  }+                | otherwise       -> next sources { hackages = mkPkg: hackages sources }             where+              prefix x = x `T.isPrefixOf` name+              next s2  = go s2 more               mkDir = Directory (fromText name) flags               mkPkg = Package name flags-              mkGit = let (realFlags, tags) = partition (T.isPrefixOf "-") flags in+              mkGit = GitPackage name realFlags tag+              mkDarcs =+                case T.stripPrefix "darcs:" name of+                  Nothing       -> error $ unpack $ "did not understand" <> T.intercalate " " (asList (Package name flags))+                  Just realName -> DarcsPackage realName realFlags tag+              (realFlags, tag) = let (rf, 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)+                  else (rf, headMay tags)

@@ -1,5 +1,5 @@ name:            cabal-meta-version:         0.2.3.2+version:         0.3 license:         BSD3 license-file:    LICENSE author:          Greg Weber <greg@gregweber.info>@@ -51,7 +51,7 @@   type:           exitcode-stdio-1.0    build-depends: shelly >= 0.9-               , hspec, HUnit, unix, base, text, system-filepath+               , hspec >= 1.3, unix, base, text, system-filepath                -- , file-location   extensions: OverloadedStrings  

@@ -1,9 +1,7 @@ {-# LANGUAGE OverloadedStrings #-} import Shelly import CabalMeta-import Test.Hspec.Monadic-import Test.HUnit ((@?=),(@=?), Assertion, assertFailure, assertBool)-import Test.Hspec.HUnit ()+import Test.Hspec import Data.Text.Lazy () import System.IO import Filesystem.Path.CurrentOS hiding (fromText, (</>))@@ -17,4 +15,4 @@       return (ps, d)      let localize = (\p-> toTextIgnore $ wd </> fromText p)-    concatMap asList (packages psources) @?= [localize "test/child/grandchild", "top-package", "sphinx", "-fone-one-beta", "child-package"]+    concatMap asList (packages psources) `shouldBe` [localize "test/child/grandchild", "top-package", "sphinx", "-fone-one-beta", "child-package"]