Switch to the tar package, drop builtin code

The current incarnation of the tar package originated as code inside
cabal-install. That external tar package is now quite mature, with more
features and is much faster. In particular the tar index features will
be very useful for cabal-install, which currently has to maintain its
own custom-format index/cache.

cabal-install/Distribution/Client/IndexUtils.hs

@@ -28,6 +28,9 @@ module Distribution.Client.IndexUtils (
   BuildTreeRefType(..), refTypeFromTypeCode, typeCodeFromRefType
   ) where
 
+import qualified Codec.Archive.Tar       as Tar
+import qualified Codec.Archive.Tar.Entry as Tar
+import qualified Codec.Archive.Tar.Index as Tar
 import qualified Distribution.Client.Tar as Tar
 import Distribution.Client.Types
 
@@ -284,12 +287,12 @@ parsePackageIndex = concatMap (uncurry extract) . tarEntriesList . Tar.read
 --
 -- NOTE: This preserves the lazy nature of 'Entries': the tar file is only read
 -- as far as the list is evaluated.
-tarEntriesList :: Tar.Entries -> [(BlockNo, Tar.Entry)]
+tarEntriesList :: Show e => Tar.Entries e -> [(BlockNo, Tar.Entry)]
 tarEntriesList = go 0
   where
     go !_ Tar.Done         = []
-    go !_ (Tar.Fail e)     = error ("tarEntriesList: " ++ e)
-    go !n (Tar.Next e es') = (n, e) : go (n + Tar.entrySizeInBlocks e) es'
+    go !_ (Tar.Fail e)     = error ("tarEntriesList: " ++ show e)
+    go !n (Tar.Next e es') = (n, e) : go (Tar.nextEntryOffset e n) es'
 
 extractPkg :: Tar.Entry -> BlockNo -> Maybe (IO (Maybe PackageEntry))
 extractPkg entry blockNo = case Tar.entryContent entry of
@@ -470,22 +473,13 @@ packageIndexFromCache mkPkg hnd Cache{..} mode = accum mempty [] cacheEntries
 
     getEntryContent :: BlockNo -> IO ByteString
     getEntryContent blockno = do
-      hSeek hnd AbsoluteSeek (fromIntegral (blockno * 512))
-      header  <- BS.hGet hnd 512
-      size    <- getEntrySize header
-      BS.hGet hnd (fromIntegral size)
-
-    getEntrySize :: ByteString -> IO Tar.FileSize
-    getEntrySize header =
-      case Tar.read header of
-        Tar.Next e _ ->
-          case Tar.entryContent e of
-            Tar.NormalFile _ size -> return size
-            Tar.OtherEntryType typecode _ size
-              | Tar.isBuildTreeRefTypeCode typecode
-                                  -> return size
-            _                     -> interror "unexpected tar entry type"
-        _ -> interror "could not read tar file entry"
+      entry <- Tar.hReadEntry hnd blockno
+      case Tar.entryContent entry of
+        Tar.NormalFile content _size -> return content
+        Tar.OtherEntryType typecode content _size
+          | Tar.isBuildTreeRefTypeCode typecode
+          -> return content
+        _ -> interror "unexpected tar entry type"
 
     readPackageDescription :: ByteString -> IO GenericPackageDescription
     readPackageDescription content =
@@ -504,7 +498,7 @@ packageIndexFromCache mkPkg hnd Cache{..} mode = accum mempty [] cacheEntries
 -- | Tar files are block structured with 512 byte blocks. Every header and file
 -- content starts on a block boundary.
 --
-type BlockNo = Int
+type BlockNo = Tar.TarEntryOffset
 
 data IndexCacheEntry = CachePackageId PackageId BlockNo
                      | CacheBuildTreeRef BuildTreeRefType BlockNo
@@ -552,8 +546,9 @@ readIndexCacheEntry = \line ->
 
     parseBlockNo str =
       case BSS.readInt str of
-        Just (blockno, remainder) | BSS.null remainder -> Just blockno
-        _                                              -> Nothing
+        Just (blockno, remainder)
+          | BSS.null remainder -> Just (fromIntegral blockno)
+        _                      -> Nothing
 
     parseRefType str =
       case BSS.uncons str of

cabal-install/Distribution/Client/Sandbox/Index.hs

@@ -19,6 +19,9 @@ module Distribution.Client.Sandbox.Index (
     defaultIndexFileName
   ) where
 
+import qualified Codec.Archive.Tar       as Tar
+import qualified Codec.Archive.Tar.Entry as Tar
+import qualified Codec.Archive.Tar.Index as Tar
 import qualified Distribution.Client.Tar as Tar
 import Distribution.Client.IndexUtils ( BuildTreeRefType(..)
                                       , refTypeFromTypeCode
@@ -39,7 +42,7 @@ import Distribution.Compat.Exception   ( tryIO )
 import Distribution.Verbosity    ( Verbosity )
 
 import qualified Data.ByteString.Lazy as BS
-import Control.Exception         ( evaluate )
+import Control.Exception         ( evaluate, throw, Exception )
 import Control.Monad             ( liftM, unless )
 import Control.Monad.Writer.Lazy (WriterT(..), runWriterT, tell)
 import Data.List                 ( (\\), intersect, nub, find )
@@ -49,8 +52,7 @@ import System.Directory          ( createDirectoryIfMissing,
                                    doesDirectoryExist, doesFileExist,
                                    renameFile, canonicalizePath)
 import System.FilePath           ( (</>), (<.>), takeDirectory, takeExtension )
-import System.IO                 ( IOMode(..), SeekMode(..)
-                                 , hSeek, withBinaryFile )
+import System.IO                 ( IOMode(..), withBinaryFile )
 
 -- | A reference to a local build tree.
 data BuildTreeRef = BuildTreeRef {
@@ -83,11 +85,11 @@ readBuildTreeRef entry = case Tar.entryContent entry of
 
 -- | Given a sequence of tar archive entries, extract all references to local
 -- build trees.
-readBuildTreeRefs :: Tar.Entries -> [BuildTreeRef]
+readBuildTreeRefs :: Exception e => Tar.Entries e -> [BuildTreeRef]
 readBuildTreeRefs =
   catMaybes
-  . Tar.foldrEntries (\e r -> readBuildTreeRef e : r)
-  [] error
+  . Tar.foldEntries (\e r -> readBuildTreeRef e : r)
+                    [] throw
 
 -- | Given a path to a tar archive, extract all references to local build trees.
 readBuildTreeRefsFromFile :: FilePath -> IO [BuildTreeRef]
@@ -146,13 +148,9 @@ addBuildTreeRefs verbosity path l' refType = do
   treesToAdd <- mapM (buildTreeRefFromPath refType) (l \\ treesInIndex)
   let entries = map writeBuildTreeRef (catMaybes treesToAdd)
   unless (null entries) $ do
-    offset <-
-      fmap (Tar.foldrEntries (\e acc -> Tar.entrySizeInBytes e + acc) 0 error
-            . Tar.read) $ BS.readFile path
-    _ <- evaluate offset
-    debug verbosity $ "Writing at offset: " ++ show offset
     withBinaryFile path ReadWriteMode $ \h -> do
-      hSeek h AbsoluteSeek (fromIntegral offset)
+      block <- Tar.hSeekEndEntryOffset h Nothing
+      debug verbosity $ "Writing at tar block: " ++ show block
       BS.hPut h (Tar.write entries)
       debug verbosity $ "Successfully appended to '" ++ path ++ "'"
     updatePackageIndexCacheFile verbosity $ SandboxIndex path
@@ -205,7 +203,7 @@ removeBuildTreeRefs verbosity indexPath l = do
         (newIdx, changedPaths) <-
           Tar.read `fmap` BS.readFile indexPath
           >>= runWriterT . Tar.filterEntriesM (p $ fmap snd srcRefs)
-        BS.writeFile tmpFile $ Tar.writeEntries newIdx
+        BS.writeFile tmpFile . Tar.write . Tar.entriesToList $ newIdx
         return changedPaths
 
       p :: [FilePath] -> Tar.Entry -> WriterT [FilePath] IO Bool