mirror of
https://github.com/input-output-hk/foliage.git
synced 2024-09-11 12:25:55 +03:00
Backtrack on previous change an use cabal-install for sdists
This commit is contained in:
parent
42a2e7f52f
commit
dd3934c99d
@ -1,86 +0,0 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
-- | Utilities to implement cabal @v2-sdist@.
|
||||
--
|
||||
-- NOTE: copied from cabal-install-3.10.1.0 it should not change but it could
|
||||
module Distribution.Client.SrcDist
|
||||
( packageDirToSdist,
|
||||
)
|
||||
where
|
||||
|
||||
import Codec.Archive.Tar qualified as Tar
|
||||
import Codec.Archive.Tar.Entry qualified as Tar
|
||||
import Codec.Compression.GZip qualified as GZip
|
||||
import Control.Monad (when)
|
||||
import Control.Monad.State.Lazy (StateT, evalStateT, gets, modify)
|
||||
import Control.Monad.Trans (liftIO)
|
||||
import Control.Monad.Writer.Lazy (WriterT, execWriterT, tell)
|
||||
import Data.ByteString qualified as BS
|
||||
import Data.ByteString.Lazy qualified as BSL
|
||||
import Data.Foldable (for_)
|
||||
import Data.List (nub, sort)
|
||||
import Data.Set qualified as Set
|
||||
import Distribution.Package (Package (packageId))
|
||||
import Distribution.PackageDescription.Configuration (flattenPackageDescription)
|
||||
import Distribution.Pretty (prettyShow)
|
||||
import Distribution.Simple.PreProcess (knownSuffixHandlers)
|
||||
import Distribution.Simple.SrcDist (listPackageSourcesWithDie)
|
||||
import Distribution.Simple.Utils (die')
|
||||
import Distribution.Types.GenericPackageDescription (GenericPackageDescription)
|
||||
import Distribution.Verbosity (Verbosity)
|
||||
import System.FilePath (normalise, takeDirectory, (</>))
|
||||
|
||||
-- | Create a tarball for a package in a directory
|
||||
packageDirToSdist ::
|
||||
Verbosity ->
|
||||
-- | read in GPD
|
||||
GenericPackageDescription ->
|
||||
-- | directory containing that GPD
|
||||
FilePath ->
|
||||
-- | resulting sdist tarball
|
||||
IO BSL.ByteString
|
||||
packageDirToSdist verbosity gpd dir = do
|
||||
let thisDie :: Verbosity -> String -> IO a
|
||||
thisDie v s = die' v $ "sdist of " <> prettyShow (packageId gpd) ++ ": " ++ s
|
||||
|
||||
files' <- listPackageSourcesWithDie verbosity thisDie dir (flattenPackageDescription gpd) knownSuffixHandlers
|
||||
let files :: [FilePath]
|
||||
files = nub $ sort $ map normalise files'
|
||||
|
||||
let entriesM :: StateT (Set.Set FilePath) (WriterT [Tar.Entry] IO) ()
|
||||
entriesM = do
|
||||
let prefix = prettyShow (packageId gpd)
|
||||
modify (Set.insert prefix)
|
||||
case Tar.toTarPath True prefix of
|
||||
Left err -> liftIO $ die' verbosity ("Error packing sdist: " ++ err)
|
||||
Right path -> tell [Tar.directoryEntry path]
|
||||
|
||||
for_ files $ \file -> do
|
||||
let fileDir = takeDirectory (prefix </> file)
|
||||
needsEntry <- gets (Set.notMember fileDir)
|
||||
|
||||
when needsEntry $ do
|
||||
modify (Set.insert fileDir)
|
||||
case Tar.toTarPath True fileDir of
|
||||
Left err -> liftIO $ die' verbosity ("Error packing sdist: " ++ err)
|
||||
Right path -> tell [Tar.directoryEntry path]
|
||||
|
||||
contents <- liftIO . fmap BSL.fromStrict . BS.readFile $ dir </> file
|
||||
case Tar.toTarPath False (prefix </> file) of
|
||||
Left err -> liftIO $ die' verbosity ("Error packing sdist: " ++ err)
|
||||
Right path -> tell [(Tar.fileEntry path contents) {Tar.entryPermissions = Tar.ordinaryFilePermissions}]
|
||||
|
||||
entries <- execWriterT (evalStateT entriesM mempty)
|
||||
let -- Pretend our GZip file is made on Unix.
|
||||
normalize bs = BSL.concat [pfx, "\x03", rest']
|
||||
where
|
||||
(pfx, rest) = BSL.splitAt 9 bs
|
||||
rest' = BSL.tail rest
|
||||
-- The Unix epoch, which is the default value, is
|
||||
-- unsuitable because it causes unpacking problems on
|
||||
-- Windows; we need a post-1980 date. One gigasecond
|
||||
-- after the epoch is during 2001-09-09, so that does
|
||||
-- nicely. See #5596.
|
||||
setModTime :: Tar.Entry -> Tar.Entry
|
||||
setModTime entry = entry {Tar.entryTime = 1000000000}
|
||||
return . normalize . GZip.compress . Tar.write $ fmap setModTime entries
|
@ -17,7 +17,6 @@ executable foliage
|
||||
hs-source-dirs: app
|
||||
other-modules:
|
||||
Distribution.Aeson
|
||||
Distribution.Client.SrcDist
|
||||
Distribution.Types.Orphans
|
||||
Foliage.CmdBuild
|
||||
Foliage.CmdCreateKeys
|
||||
@ -46,18 +45,17 @@ executable foliage
|
||||
base >=4.14.3.0 && <4.18,
|
||||
aeson >=2.0.3.0 && <2.2,
|
||||
base16 >=0.3.2.0 && <0.4,
|
||||
base64 >=0.4.2.3 && <0.5,
|
||||
binary >=0.8.9.0 && <0.9,
|
||||
bytestring >=0.10.12.0 && <0.12,
|
||||
Cabal >=3.10 && <3.11,
|
||||
Cabal-syntax >=3.10 && <3.11,
|
||||
cabal-install >=3.10 && <3.11,
|
||||
containers >=0.6.5.1 && <0.7,
|
||||
cryptohash-sha256 >=0.11.102.1 && <0.12,
|
||||
directory >=1.3.6.0 && <1.4,
|
||||
ed25519 >=0.0.5.0 && <0.1,
|
||||
filepath >=1.4.2.1 && <1.5,
|
||||
hackage-security >=0.6.2.1 && <0.7,
|
||||
mtl >=2.2.2 && <2.3,
|
||||
network-uri >=2.6.4.1 && <2.7,
|
||||
optparse-applicative >=0.17.0.0 && <0.18,
|
||||
shake >=0.19.6 && <0.20,
|
||||
|
Loading…
Reference in New Issue
Block a user