cabal-cache 1.0.0.10 → 1.0.0.11

raw patch · 10 files changed

+15/−200 lines, 10 filesdep +relationPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: relation

API changes (from Hackage documentation)

Files

• README.md +1/−1
• cabal-cache.cabal +4/−4
• src/App/Commands/SyncToArchive.hs +1/−1
• src/HaskellWorks/CabalCache/Concurrent/DownloadQueue.hs +4/−4
• src/HaskellWorks/CabalCache/Concurrent/Type.hs +3/−3
• src/HaskellWorks/CabalCache/Data/Relation.hs +0/−93
• src/HaskellWorks/CabalCache/Data/Relation/Type.hs +0/−15
• src/HaskellWorks/CabalCache/Version.hs +1/−1
• test/HaskellWorks/CabalCache/AwsSpec.hs +1/−1
• test/HaskellWorks/CabalCache/Data/RelationSpec.hs +0/−77

@@ -113,7 +113,7 @@ Both tarballs are identical.  If they both exist then the first may be a symlink to the second when store on the filesystem. -The direct subdirectories of the archive is the `${archive_verson}`, for example `v1`.  This is the+The direct subdirectories of the archive is the `${archive_verson}`, for example `v2`.  This is the version of the archive format.  This corresponds to the major version of the `cabal-cache` package.  The next directory may be the `${store_hash}` or the `${compiler_id}`.  If it is the `${store_hash}`

@@ -1,7 +1,7 @@ cabal-version:          2.2  name:                   cabal-cache-version:                1.0.0.10+version:                1.0.0.11 synopsis:               CI Assistant for Haskell projects description:            CI Assistant for Haskell projects.  Implements package caching. homepage:               https://github.com/haskell-works/cabal-cache@@ -46,6 +46,7 @@ common optparse-applicative           { build-depends: optparse-applicative           >= 0.14       && < 0.15   } common process                        { build-depends: process                        >= 1.6.5.0    && < 1.7    } common raw-strings-qq                 { build-depends: raw-strings-qq                 >= 1.1        && < 2      }+common relation                       { build-depends: relation                       >= 0.5        && < 0.6    } common resourcet                      { build-depends: resourcet                      >= 1.2.2      && < 1.3    } common selective                      { build-depends: selective                      >= 0.1.0      && < 0.2    } common stm                            { build-depends: stm                            >= 2.5.0.0    && < 3      }@@ -86,6 +87,7 @@           , mtl           , optparse-applicative           , process+          , relation           , resourcet           , selective           , stm@@ -114,8 +116,6 @@       HaskellWorks.CabalCache.Concurrent.Fork       HaskellWorks.CabalCache.Concurrent.Type       HaskellWorks.CabalCache.Core-      HaskellWorks.CabalCache.Data.Relation-      HaskellWorks.CabalCache.Data.Relation.Type       HaskellWorks.CabalCache.GhcPkg       HaskellWorks.CabalCache.Hash       HaskellWorks.CabalCache.IO.Console@@ -156,6 +156,7 @@           , hw-hspec-hedgehog           , lens           , raw-strings-qq+          , relation           , text    type:                 exitcode-stdio-1.0@@ -166,6 +167,5 @@   build-tools:          hspec-discover   other-modules:       HaskellWorks.CabalCache.AwsSpec-      HaskellWorks.CabalCache.Data.RelationSpec       HaskellWorks.CabalCache.LocationSpec       HaskellWorks.CabalCache.QuerySpec

@@ -125,7 +125,7 @@                  metas <- createMetadata tempPath pInfo [("store-path", LC8.pack storePath)] -                IO.createTar tempArchiveFile (metas:rp2)+                IO.createTar tempArchiveFile (rp2 <> [metas])                  void $ catchError (liftIO (LBS.readFile tempArchiveFile) >>= IO.writeResource envAws targetFile) $ \case                   e@(AwsAppError (HTTP.Status 301 _)) -> do

@@ -13,9 +13,9 @@  import qualified Control.Concurrent.STM                  as STM import qualified Data.Map                                as M+import qualified Data.Relation                           as R import qualified Data.Set                                as S import qualified HaskellWorks.CabalCache.Concurrent.Type as Z-import qualified HaskellWorks.CabalCache.Data.Relation   as R  anchor :: Z.PackageId -> M.Map Z.ConsumerId Z.ProviderId -> M.Map Z.ConsumerId Z.ProviderId anchor root dependencies = M.union dependencies $ M.singleton root (mconcat (M.elems dependencies))@@ -33,13 +33,13 @@   uploading     <- STM.readTVar tUploading   failures      <- STM.readTVar tFailures -  let ready = R.range dependencies \\ R.domain dependencies \\ uploading \\ failures+  let ready = R.ran dependencies \\ R.dom dependencies \\ uploading \\ failures    case S.lookupMin ready of     Just packageId -> do       STM.writeTVar tUploading (S.insert packageId uploading)       return (Just packageId)-    Nothing -> if S.null (R.range dependencies \\ R.domain dependencies \\ failures)+    Nothing -> if S.null (R.ran dependencies \\ R.dom dependencies \\ failures)       then return Nothing       else STM.retry @@ -49,7 +49,7 @@   uploading     <- STM.readTVar tUploading    STM.writeTVar tUploading    $ S.delete packageId uploading-  STM.writeTVar tDependencies $ R.withoutRange (S.singleton packageId) dependencies+  STM.writeTVar tDependencies $ R.withoutRan (S.singleton packageId) dependencies  failDownload :: Z.DownloadQueue -> Z.PackageId -> STM.STM () failDownload Z.DownloadQueue {..} packageId = do

@@ -11,9 +11,9 @@ import GHC.Generics import HaskellWorks.CabalCache.Types (PackageId) -import qualified Control.Concurrent.STM                as STM-import qualified Data.Set                              as S-import qualified HaskellWorks.CabalCache.Data.Relation as R+import qualified Control.Concurrent.STM as STM+import qualified Data.Relation          as R+import qualified Data.Set               as S  type ConsumerId = PackageId type ProviderId = PackageId

@@ -1,93 +0,0 @@-module HaskellWorks.CabalCache.Data.Relation-  ( Relation(Relation)-  , empty-  , null-  , fromList-  , toList-  , singleton-  , insert-  , delete-  , domain-  , range-  , restrictDomain-  , restrictRange-  , withoutDomain-  , withoutRange-  ) where--import HaskellWorks.CabalCache.Data.Relation.Type (Relation (Relation))-import Prelude                                    hiding (null)--import qualified Data.Map                                   as M-import qualified Data.Set                                   as S-import qualified HaskellWorks.CabalCache.Data.Relation.Type as R--empty :: Relation a b-empty = Relation M.empty M.empty--null :: Relation a b -> Bool-null = M.null . R.domain--fromList :: (Ord a, Ord b) => [(a, b)] -> Relation a b-fromList rs = Relation-  { R.domain  = M.fromListWith S.union $ map (\(x, y) -> (x, S.singleton y)) rs-  , R.range   = M.fromListWith S.union $ map (\(x, y) -> (y, S.singleton x)) rs-  }--toList :: Relation a b -> [(a, b)]-toList r = concatMap-  (\(x, y) -> zip (repeat x) (S.toList y))-  (M.toList (R.domain  r))--singleton :: a -> b -> Relation a b-singleton x y = Relation-  { R.domain  = M.singleton x (S.singleton y)-  , R.range   = M.singleton y (S.singleton x)-  }--insert :: (Ord a, Ord b) => a -> b -> Relation a b -> Relation a b-insert x y r = Relation-  { R.domain  = M.insertWith S.union x (S.singleton y) (R.domain r)-  , R.range   = M.insertWith S.union y (S.singleton x) (R.range  r)-  }--delete :: (Ord a, Ord b) =>  a -> b -> Relation a b -> Relation a b-delete x y r = r-  { R.domain  = M.update (justUnlessEmpty . S.delete y) x (R.domain r)-  , R.range   = M.update (justUnlessEmpty . S.delete x) y (R.range  r)-  }--domain ::  Relation a b -> S.Set a-domain r = M.keysSet (R.domain r)--range ::  Relation a b -> S.Set b-range r = M.keysSet (R.range r)--restrictDomain :: (Ord a, Ord b) => S.Set a -> Relation a b -> Relation a b-restrictDomain s r = R.Relation-  { R.domain = M.restrictKeys (R.domain r) s-  , R.range  = M.mapMaybe (justUnlessEmpty . S.intersection s) (R.range r)-  }--restrictRange :: (Ord a, Ord b) => S.Set b -> Relation a b -> Relation a b-restrictRange s r = R.Relation-  { R.domain  = M.mapMaybe (justUnlessEmpty . S.intersection s) (R.domain r)-  , R.range   = M.restrictKeys (R.range r) s-  }--withoutDomain :: (Ord a, Ord b) => S.Set a -> Relation a b -> Relation a b-withoutDomain s r = R.Relation-  { R.domain = M.withoutKeys (R.domain r) s-  , R.range  = M.mapMaybe (justUnlessEmpty . flip S.difference s) (R.range r)-  }--withoutRange :: (Ord a, Ord b) => S.Set b -> Relation a b -> Relation a b-withoutRange s r = R.Relation-  { R.domain  = M.mapMaybe (justUnlessEmpty . flip S.difference s) (R.domain r)-  , R.range   = M.withoutKeys (R.range r) s-  }----------justUnlessEmpty :: S.Set a -> Maybe (S.Set a)-justUnlessEmpty c = if S.null c then Nothing else Just c

@@ -1,15 +0,0 @@-{-# LANGUAGE DeriveGeneric #-}--module HaskellWorks.CabalCache.Data.Relation.Type-  ( Relation (..)-  ) where--import GHC.Generics--import qualified Data.Map as M-import qualified Data.Set as S--data Relation a b = Relation-  { domain :: M.Map a (S.Set b)-  , range  :: M.Map b (S.Set a)-  } deriving (Eq, Show, Ord, Generic)

@@ -5,4 +5,4 @@ import Data.String  archiveVersion :: IsString s => s-archiveVersion = "v1"+archiveVersion = "v2"

@@ -28,7 +28,7 @@  spec :: Spec spec = describe "HaskellWorks.CabalCache.QuerySpec" $ do-  it "stub" $ requireTest $ do+  xit "stub" $ requireTest $ do     ci <- liftIO $ IO.lookupEnv "CI" <&> isJust     unless ci $ do       envAws <- liftIO $ mkEnv Oregon (const LBSC.putStrLn)

@@ -1,77 +0,0 @@-{-# LANGUAGE DataKinds         #-}-{-# LANGUAGE OverloadedStrings #-}-module HaskellWorks.CabalCache.Data.RelationSpec-  ( spec-  ) where--import HaskellWorks.Hspec.Hedgehog-import Hedgehog-import Test.Hspec--import qualified Data.List                             as L-import qualified Data.Set                              as S-import qualified HaskellWorks.CabalCache.Data.Relation as R-import qualified Hedgehog.Gen                          as G-import qualified Hedgehog.Range                        as R--{-# ANN module ("HLint: ignore Redundant do"        :: String) #-}-{-# ANN module ("HLint: ignore Reduce duplication"  :: String) #-}-{-# ANN module ("HLint: ignore Redundant bracket"   :: String) #-}--spec :: Spec-spec = describe "HaskellWorks.Assist.Data.RelationSpec" $ do-  it "List roundtrip" $ require $ property $ do-    as <- forAll $ G.list (R.linear 0 10) $ (,)-      <$> G.int R.constantBounded-      <*> G.alpha-    L.sort (R.toList (R.fromList as)) === L.sort as-  it "Full domain restriction" $ require $ property $ do-    as <- forAll $ G.list (R.linear 0 10) $ (,)-      <$> G.int R.constantBounded-      <*> G.alpha--    R.restrictDomain S.empty (R.fromList as) === R.empty-  it "Full range restriction" $ require $ property $ do-    as <- forAll $ G.list (R.linear 0 10) $ (,)-      <$> G.int R.constantBounded-      <*> G.alpha--    R.restrictRange S.empty (R.fromList as) === R.empty-  it "No domain restriction" $ require $ property $ do-    as <- forAll $ G.list (R.linear 0 10) $ (,)-      <$> G.int R.constantBounded-      <*> G.alpha-    let r = R.fromList as--    R.restrictDomain (R.domain r) r === r-  it "No range restriction" $ require $ property $ do-    as <- forAll $ G.list (R.linear 0 10) $ (,)-      <$> G.int R.constantBounded-      <*> G.alpha-    let r = R.fromList as-    R.restrictRange (R.range r) r === r-  it "Full domain without" $ require $ property $ do-    as <- forAll $ G.list (R.linear 0 10) $ (,)-      <$> G.int R.constantBounded-      <*> G.alpha-    let r = R.fromList as-    R.withoutDomain S.empty r === r-  it "Full range without" $ require $ property $ do-    as <- forAll $ G.list (R.linear 0 10) $ (,)-      <$> G.int R.constantBounded-      <*> G.alpha-    let r = R.fromList as-    R.withoutRange S.empty r === r-  it "No domain without" $ require $ property $ do-    as <- forAll $ G.list (R.linear 0 10) $ (,)-      <$> G.int R.constantBounded-      <*> G.alpha-    let r = R.fromList as--    R.withoutDomain (R.domain r) r === R.empty-  it "No range without" $ require $ property $ do-    as <- forAll $ G.list (R.linear 0 10) $ (,)-      <$> G.int R.constantBounded-      <*> G.alpha-    let r = R.fromList as-    R.withoutRange (R.range r) r === R.empty