mirror of
https://github.com/commercialhaskell/stackage.git
synced 2026-01-12 07:18:31 +01:00
50 lines
1.8 KiB
Haskell
50 lines
1.8 KiB
Haskell
{-# LANGUAGE CPP #-}
|
|
module Stackage.Tarballs
|
|
( makeTarballs
|
|
) where
|
|
|
|
import qualified Codec.Archive.Tar as Tar
|
|
import Control.Exception (throwIO)
|
|
import qualified Data.ByteString.Lazy as L
|
|
import qualified Data.Map as Map
|
|
import qualified Data.Set as Set
|
|
import Stackage.Types
|
|
import Stackage.Util
|
|
import System.Directory (createDirectoryIfMissing)
|
|
import System.FilePath (takeDirectory)
|
|
|
|
makeTarballs :: InstallInfo -> IO ()
|
|
makeTarballs ii = do
|
|
tarName <- getTarballName
|
|
origEntries <- fmap Tar.read $ L.readFile tarName
|
|
(stableEntries, extraEntries) <- loop id id origEntries
|
|
|
|
(stableTar, extraTar) <- getStackageTarballNames
|
|
|
|
createDirectoryIfMissing True $ takeDirectory stableTar
|
|
L.writeFile stableTar $ Tar.write stableEntries
|
|
|
|
createDirectoryIfMissing True $ takeDirectory extraTar
|
|
L.writeFile extraTar $ Tar.write extraEntries
|
|
where
|
|
#if MIN_VERSION_tar(0, 4, 0)
|
|
loop _ _ (Tar.Fail err) = throwIO err
|
|
#else
|
|
loop _ _ (Tar.Fail err) = error err
|
|
#endif
|
|
loop stable extra Tar.Done = return (stable [], extra [])
|
|
loop stable extra (Tar.Next e es) =
|
|
loop stable' extra' es
|
|
where
|
|
(stable', extra') =
|
|
case getPackageVersion e of
|
|
Nothing -> (stable, extra)
|
|
Just (package, version) ->
|
|
case Map.lookup package $ iiPackages ii of
|
|
Just version'
|
|
| version == version' -> (stable . (e:), extra)
|
|
| otherwise -> (stable, extra)
|
|
Nothing
|
|
| package `Set.member` iiCore ii -> (stable, extra)
|
|
| otherwise -> (stable, extra . (e:))
|