1- -- | This script checks for new package versions by fetching GitHub tags for all
2- -- | packages in the registry. When a new version is discovered (a tag that hasn't
3- -- | been published or unpublished), it submits a publish job to the registry API.
1+ -- | This script checks for new package versions by fetching commits from the last
2+ -- | 24 hours for all packages in the registry. When a recent commit is found that
3+ -- | corresponds to an unpublished version tag, it submits a publish job to the
4+ -- | registry API.
45-- |
56-- | Run via Nix:
67-- | nix run .#daily-importer -- --dry-run # Log what would be submitted
78-- | nix run .#daily-importer -- --submit # Actually submit to the API
89-- |
910-- | Required environment variables:
10- -- | GITHUB_TOKEN - GitHub API token for fetching tags
11+ -- | GITHUB_TOKEN - GitHub API token for fetching commits and tags
1112-- | REGISTRY_API_URL - Registry API URL (default: https://registry.purescript.org)
1213module Registry.Scripts.DailyImporter where
1314
@@ -18,10 +19,13 @@ import ArgParse.Basic as Arg
1819import Codec.JSON.DecodeError as CJ.DecodeError
1920import Data.Array as Array
2021import Data.Codec.JSON as CJ
22+ import Data.DateTime as DateTime
2123import Data.Map as Map
2224import Data.Set as Set
25+ import Data.Time.Duration (Hours (..))
2326import Effect.Aff as Aff
2427import Effect.Class.Console as Console
28+ import Effect.Now as Now
2529import Fetch (Method (..))
2630import Fetch as Fetch
2731import JSON as JSON
@@ -112,46 +116,63 @@ runDailyImport :: Mode -> URL -> Run DailyImportEffects Unit
112116runDailyImport mode registryApiUrl = do
113117 Log .info " Daily Importer: checking for new package versions..."
114118
119+ now <- Run .liftEffect Now .nowDateTime
120+ let since = fromMaybe now $ DateTime .adjust (Hours (-24.0
121+
115122 allMetadata <- Registry .readAllMetadata
116123 let packages = Map .toUnfoldable allMetadata :: Array (Tuple PackageName Metadata )
117124
118- Log .info $ " Checking " Array .length packages) <> " packages for new versions ..."
125+ Log .info $ " Checking " Array .length packages) <> " packages for commits in the last 24 hours ..."
119126
120127 submitted <- for packages \(Tuple name (Metadata metadata)) -> do
121128 case metadata.location of
122129 Git _ -> pure 0 -- Skip non-GitHub packages for now
123130 GitHub { owner, repo } -> do
124- GitHub .listTags { owner, repo } >>= case _ of
131+ let address = { owner, repo }
132+ -- First, check if there are any recent commits
133+ GitHub .listCommitsSince address since >>= case _ of
125134 Left err -> do
126- Log .debug $ " Failed to fetch tags for " PackageName .print name <> " : " Octokit .printGitHubError err
135+ Log .debug $ " Failed to fetch commits for " PackageName .print name <> " : " Octokit .printGitHubError err
136+ pure 0
137+ Right [] -> do
138+ -- No recent commits, skip fetching tags
127139 pure 0
128- Right tags -> do
129- let
130- -- Combine published and unpublished versions into a set
131- publishedVersions = Set .fromFoldable
132- $ Map .keys metadata.published
133- <> Map .keys metadata.unpublished
134-
135- -- Parse tags as versions and filter out already published ones
136- newVersions = Array .catMaybes $ tags <#> \tag ->
137- case LenientVersion .parse tag.name of
138- Left _ -> Nothing -- Not a valid version tag
139- Right result ->
140- let
141- version = LenientVersion .version result
142- in
143- if Set .member version publishedVersions then Nothing
144- else Just { version, ref: tag.name }
145-
146- -- Submit publish jobs for new versions
147- count <- for newVersions \{ version, ref } -> do
148- submitPublishJob mode registryApiUrl name version ref
149-
150- pure $ Array .length $ Array .filter identity count
140+ Right recentCommitShas -> do
141+ let recentShas = Set .fromFoldable recentCommitShas
142+ -- There are recent commits, now fetch tags to see if any point to them
143+ GitHub .listTags address >>= case _ of
144+ Left err -> do
145+ Log .debug $ " Failed to fetch tags for " PackageName .print name <> " : " Octokit .printGitHubError err
146+ pure 0
147+ Right tags -> do
148+ let
149+ publishedVersions = combinedPublishedVersions { published: metadata.published, unpublished: metadata.unpublished }
150+ newVersions = findNewVersions tags recentShas publishedVersions
151+
152+ -- Submit publish jobs for new versions
153+ count <- for newVersions \{ version, ref } -> do
154+ submitPublishJob mode registryApiUrl name version ref
155+
156+ pure $ Array .length $ Array .filter identity count
151157
152158 let totalSubmitted = Array .foldl (+) 0
153159 Log .info $ " Daily Importer complete. Submitted " " publish jobs."
154160
161+ -- | Combine published and unpublished versions into a set
162+ combinedPublishedVersions :: forall a b . { published :: Map Version a , unpublished :: Map Version b } -> Set Version
163+ combinedPublishedVersions metadata = Set .fromFoldable $ Map .keys metadata.published <> Map .keys metadata.unpublished
164+
165+ -- | Find new version tags that point to recent commits and haven't been published
166+ findNewVersions :: Array Octokit.Tag -> Set String -> Set Version -> Array { version :: Version , ref :: String }
167+ findNewVersions tags recentShas publishedVersions = Array .catMaybes $ tags <#> \tag ->
168+ case LenientVersion .parse tag.name of
169+ Left _ -> Nothing -- Not a valid version tag
170+ Right result -> do
171+ let version = LenientVersion .version result
172+ if not (Set .member tag.sha recentShas) then Nothing -- Tag doesn't point to a recent commit
173+ else if Set .member version publishedVersions then Nothing -- Already published
174+ else Just { version, ref: tag.name }
175+
155176-- | Submit a publish job for a new package version. The compiler is not specified; the registry
156177-- | API will discover the latest compatible compiler based on the package's dependencies.
157178submitPublishJob :: Mode -> URL -> PackageName -> Version -> String -> Run DailyImportEffects Boolean
0 commit comments