input-output-hk/foliage
1
1
Fork 0
mirror of https://github.com/input-output-hk/foliage.git synced 2024-12-02 07:54:45 +03:00
Code Issues Packages Projects Releases Wiki Activity

Backtrack on previous change an use cabal-install for sdists

Browse Source
This commit is contained in:
Andrea Bedini 2023-05-24 11:35:34 +08:00
parent 42a2e7f52f
commit dd3934c99d
2 changed files with 1 additions and 89 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

86
app/Distribution/Client/SrcDist.hs
View File

@ -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

4
foliage.cabal
View File

@ -17,7 +17,6 @@ executable foliage
hs-source-dirs: app hs-source-dirs: app
other-modules: other-modules:
Distribution.Aeson Distribution.Aeson
Distribution.Client.SrcDist
Distribution.Types.Orphans Distribution.Types.Orphans
Foliage.CmdBuild Foliage.CmdBuild
Foliage.CmdCreateKeys Foliage.CmdCreateKeys
@ -46,18 +45,17 @@ executable foliage
base >=4.14.3.0 && <4.18, base >=4.14.3.0 && <4.18,
aeson >=2.0.3.0 && <2.2, aeson >=2.0.3.0 && <2.2,
base16 >=0.3.2.0 && <0.4, base16 >=0.3.2.0 && <0.4,
base64 >=0.4.2.3 && <0.5,
binary >=0.8.9.0 && <0.9, binary >=0.8.9.0 && <0.9,
bytestring >=0.10.12.0 && <0.12, bytestring >=0.10.12.0 && <0.12,
Cabal >=3.10 && <3.11, Cabal >=3.10 && <3.11,
Cabal-syntax >=3.10 && <3.11, Cabal-syntax >=3.10 && <3.11,
cabal-install >=3.10 && <3.11,
containers >=0.6.5.1 && <0.7, containers >=0.6.5.1 && <0.7,
cryptohash-sha256 >=0.11.102.1 && <0.12, cryptohash-sha256 >=0.11.102.1 && <0.12,
directory >=1.3.6.0 && <1.4, directory >=1.3.6.0 && <1.4,
ed25519 >=0.0.5.0 && <0.1, ed25519 >=0.0.5.0 && <0.1,
filepath >=1.4.2.1 && <1.5, filepath >=1.4.2.1 && <1.5,
hackage-security >=0.6.2.1 && <0.7, hackage-security >=0.6.2.1 && <0.7,
mtl >=2.2.2 && <2.3,
network-uri >=2.6.4.1 && <2.7, network-uri >=2.6.4.1 && <2.7,
optparse-applicative >=0.17.0.0 && <0.18, optparse-applicative >=0.17.0.0 && <0.18,
shake >=0.19.6 && <0.20, shake >=0.19.6 && <0.20,