From 934e4e8261cd23d5a76507920554ac22fac58c8e Mon Sep 17 00:00:00 2001 From: Andrea Bedini Date: Mon, 16 May 2022 16:54:27 +0800 Subject: [PATCH] Tweaks --- app/Foliage/CmdBuild.hs | 84 ++++++++++++++++++--------------- app/Foliage/CmdImportHackage.hs | 55 ++++++++++----------- 2 files changed, 70 insertions(+), 69 deletions(-) diff --git a/app/Foliage/CmdBuild.hs b/app/Foliage/CmdBuild.hs index eb316d7..9b46f04 100644 --- a/app/Foliage/CmdBuild.hs +++ b/app/Foliage/CmdBuild.hs @@ -162,9 +162,10 @@ cmdBuild keys <- readKeysAt (keysPath "timestamp") let timestampSigned = withSignatures hackageRepoLayout keys timestamp - liftIO $ do - p <- makeAbsolute (fromFilePath path) - writeJSON hackageRepoLayout p timestampSigned + traced "writing" $ + liftIO $ do + p <- makeAbsolute (fromFilePath path) + writeJSON hackageRepoLayout p timestampSigned -- -- snapshot.json @@ -188,9 +189,10 @@ cmdBuild keys <- readKeysAt (keysPath "snapshot") let snapshotSigned = withSignatures hackageRepoLayout keys snapshot - liftIO $ do - p <- makeAbsolute (fromFilePath path) - writeJSON hackageRepoLayout p snapshotSigned + traced "writing" $ + liftIO $ do + p <- makeAbsolute (fromFilePath path) + writeJSON hackageRepoLayout p snapshotSigned -- -- root.json @@ -250,9 +252,10 @@ cmdBuild keys <- readKeysAt (keysPath "root") let signedRoot = withSignatures hackageRepoLayout keys root - liftIO $ do - p <- makeAbsolute (fromFilePath path) - writeJSON hackageRepoLayout p signedRoot + traced "writing" $ + liftIO $ do + p <- makeAbsolute (fromFilePath path) + writeJSON hackageRepoLayout p signedRoot -- -- mirrors.json @@ -269,9 +272,10 @@ cmdBuild keys <- readKeysAt (keysPath "mirrors") let signedMirrors = withSignatures hackageRepoLayout keys mirrors - liftIO $ do - p <- makeAbsolute (fromFilePath path) - writeJSON hackageRepoLayout p signedMirrors + traced "writing" $ + liftIO $ do + p <- makeAbsolute (fromFilePath path) + writeJSON hackageRepoLayout p signedMirrors -- -- 01-index.tar @@ -281,35 +285,37 @@ cmdBuild pkgIds <- getPackages GetPackages entries <- - fmap concat $ - for pkgIds $ \pkgId -> do - let PackageId {pkgName, pkgVersion} = pkgId - PackageMeta {packageTimestamp, packageRevisions} <- getPackageMeta (GetPackageMeta pkgId) + flip foldMap pkgIds $ \pkgId -> do + let PackageId {pkgName, pkgVersion} = pkgId + PackageMeta {packageTimestamp, packageRevisions} <- getPackageMeta (GetPackageMeta pkgId) - srcDir <- preparePackageSource $ PreparePackageSource pkgId - now <- getCurrentTime GetCurrentTime + srcDir <- preparePackageSource $ PreparePackageSource pkgId + now <- getCurrentTime GetCurrentTime - sequence $ - [ -- original cabal file - mkTarEntry - (srcDir pkgName <.> "cabal") - (pkgName pkgVersion pkgName <.> "cabal") - (fromMaybe now packageTimestamp), - -- package.json - mkTarEntry - (outputDir "index" pkgName pkgVersion "package.json") - (pkgName pkgVersion "package.json") - (fromMaybe now packageTimestamp) - ] - ++ [ -- revised cabal files - mkTarEntry - (inputDir pkgName pkgVersion "revisions" show revNum <.> "cabal") - (pkgName pkgVersion pkgName <.> "cabal") - (fromMaybe now revTimestamp) - | RevisionMeta revTimestamp revNum <- packageRevisions - ] + -- original cabal file + cabalEntry <- + mkTarEntry + (srcDir pkgName <.> "cabal") + (pkgName pkgVersion pkgName <.> "cabal") + (fromMaybe now packageTimestamp) - liftIO $ BSL.writeFile path $ Tar.write (sortOn Tar.entryTime entries) + -- package.json + packageEntry <- + mkTarEntry + (outputDir "index" pkgName pkgVersion "package.json") + (pkgName pkgVersion "package.json") + (fromMaybe now packageTimestamp) + + -- revised cabal files + revisionEntries <- for packageRevisions $ \RevisionMeta {revisionNumber, revisionTimestamp} -> + mkTarEntry + (inputDir pkgName pkgVersion "revisions" show revisionNumber <.> "cabal") + (pkgName pkgVersion pkgName <.> "cabal") + (fromMaybe now revisionTimestamp) + + return $ cabalEntry : packageEntry : revisionEntries + + traced "writing" $ liftIO $ BSL.writeFile path $ Tar.write (sortOn Tar.entryTime entries) -- -- 01-index.tar.gz @@ -317,7 +323,7 @@ cmdBuild outputDir "01-index.tar.gz" %> \path -> do tar <- readFileByteStringLazy (outputDir "01-index.tar") - liftIO $ BSL.writeFile path (GZip.compress tar) + traced "writing" $ liftIO $ BSL.writeFile path (GZip.compress tar) -- -- index cabal files diff --git a/app/Foliage/CmdImportHackage.hs b/app/Foliage/CmdImportHackage.hs index 96364a6..6bc2243 100644 --- a/app/Foliage/CmdImportHackage.hs +++ b/app/Foliage/CmdImportHackage.hs @@ -15,8 +15,8 @@ import Data.Time.Clock.POSIX (posixSecondsToUTCTime) import Foliage.Meta import Foliage.Options import Foliage.Package -import System.Directory qualified as IO -import System.Environment +import System.Directory (createDirectoryIfMissing) +import System.Environment (getEnv) import System.FilePath cmdImportHackage :: ImportHackageOptions -> IO () @@ -48,33 +48,28 @@ importIndex f (Tar.Next e es) m = | f pkgId -> do putStrLn $ "Found cabal file " ++ pkgIdToString pkgId ++ " with time " ++ show time - m' <- - M.alterF - ( \case - -- New package - Nothing -> - pure $ - Just $ - PackageMeta - { packageSource = TarballSource (pkgIdToHackageUrl pkgId) Nothing, - packageTimestamp = Just time, - packageRevisions = [], - packageForceVersion = False - } - -- Existing package, new revision - Just sm -> do - let revnum = 1 + fromMaybe 0 (latestRevisionNumber sm) - newRevision = RevisionMeta {revisionNumber = revnum, revisionTimestamp = Just time} - -- bad performance here but I don't care - let sm' = sm {packageRevisions = packageRevisions sm ++ [newRevision]} - let PackageId pkgName pkgVersion = pkgId - let outDir = "_sources" pkgName pkgVersion "revisions" - IO.createDirectoryIfMissing True outDir - BSL.writeFile (outDir show revnum <.> "cabal") contents - return $ Just sm' - ) - pkgId - m + let -- new package + go Nothing = + pure $ + Just $ + PackageMeta + { packageSource = TarballSource (pkgIdToHackageUrl pkgId) Nothing, + packageTimestamp = Just time, + packageRevisions = [], + packageForceVersion = False + } + -- Existing package, new revision + go (Just sm) = do + let revnum = 1 + fromMaybe 0 (latestRevisionNumber sm) + newRevision = RevisionMeta {revisionNumber = revnum, revisionTimestamp = Just time} + -- Repeatedly adding at the end of a list is bad performance but good for the moment. + let sm' = sm {packageRevisions = packageRevisions sm ++ [newRevision]} + let PackageId pkgName pkgVersion = pkgId + let outDir = "_sources" pkgName pkgVersion "revisions" + createDirectoryIfMissing True outDir + BSL.writeFile (outDir show revnum <.> "cabal") contents + return $ Just sm' + m' <- M.alterF go pkgId m importIndex f es m' _ -> importIndex f es m importIndex _f Tar.Done m = @@ -88,7 +83,7 @@ finalise :: IO () finalise PackageId {pkgName, pkgVersion} meta = do let dir = "_sources" pkgName pkgVersion - IO.createDirectoryIfMissing True dir + createDirectoryIfMissing True dir writePackageMeta (dir "meta.toml") meta isCabalFile ::