Reduce number of fetched tags by using a prefix
This commit is contained in:
parent
7c9c890056
commit
47f27394de
@ -46,6 +46,8 @@ import qualified Data.Aeson.KeyMap as KeyMap
|
|||||||
import GHC.Records (HasField(..))
|
import GHC.Records (HasField(..))
|
||||||
import Control.Monad.Trans.Reader (asks)
|
import Control.Monad.Trans.Reader (asks)
|
||||||
import Control.Monad.IO.Class (MonadIO(..))
|
import Control.Monad.IO.Class (MonadIO(..))
|
||||||
|
import Control.Applicative (Applicative(liftA2))
|
||||||
|
import Data.Char (isAlpha)
|
||||||
|
|
||||||
data PackageOwner = PackageOwner
|
data PackageOwner = PackageOwner
|
||||||
{ owner :: Text
|
{ owner :: Text
|
||||||
@ -66,8 +68,25 @@ data MatchToken
|
|||||||
| OneOfMatchToken [Char]
|
| OneOfMatchToken [Char]
|
||||||
deriving (Eq, Show)
|
deriving (Eq, Show)
|
||||||
|
|
||||||
-- | Removes the leading "v" from the version string and returns the result if
|
-- | Matches a string (for example a version name or CVS tag) against a pattern.
|
||||||
-- it looks like a version.
|
-- Returns the matched part of the string or 'Nothing' if there is no match.
|
||||||
|
--
|
||||||
|
-- The pattern is just a list of characters with some special characters and
|
||||||
|
-- sequences.
|
||||||
|
--
|
||||||
|
-- * ( ) - The text in parentheses is matched but no saved in the resulting
|
||||||
|
-- string.
|
||||||
|
-- * \\d - Matches zero or more digits.
|
||||||
|
-- * \\. - Matches zero or more digits or dots.
|
||||||
|
-- * \\\\ - Matches a back slash.
|
||||||
|
-- * * - Matches everything.
|
||||||
|
--
|
||||||
|
-- For example the following expression matches tags like @v1.2.3@, but returns
|
||||||
|
-- only @1.2.3@.
|
||||||
|
--
|
||||||
|
-- @
|
||||||
|
-- (v)\\.
|
||||||
|
-- @
|
||||||
match :: Text -> Text -> Maybe Text
|
match :: Text -> Text -> Maybe Text
|
||||||
match fullPattern input =
|
match fullPattern input =
|
||||||
case Text.foldl' go (Just startState) input of
|
case Text.foldl' go (Just startState) input of
|
||||||
@ -207,6 +226,7 @@ instance Aeson.FromJSON GhData where
|
|||||||
data GhVariables = GhVariables
|
data GhVariables = GhVariables
|
||||||
{ name :: Text
|
{ name :: Text
|
||||||
, owner :: Text
|
, owner :: Text
|
||||||
|
, prefix :: Maybe Text
|
||||||
} deriving (Eq, Show)
|
} deriving (Eq, Show)
|
||||||
|
|
||||||
$(deriveJSON defaultOptions ''GhVariables)
|
$(deriveJSON defaultOptions ''GhVariables)
|
||||||
@ -226,11 +246,14 @@ latestGitHub PackageOwner{..} pattern' = do
|
|||||||
ghToken' <- SlackBuilderT $ asks ghToken
|
ghToken' <- SlackBuilderT $ asks ghToken
|
||||||
ghResponse <- runReq defaultHttpConfig $
|
ghResponse <- runReq defaultHttpConfig $
|
||||||
let uri = https "api.github.com" /: "graphql"
|
let uri = https "api.github.com" /: "graphql"
|
||||||
|
prefix = Text.takeWhile isAlpha
|
||||||
|
$ Text.filter (liftA2 (&&) (/= ')') (/= '(')) pattern'
|
||||||
query = GhQuery
|
query = GhQuery
|
||||||
{ query = githubQuery
|
{ query = githubQuery
|
||||||
, variables = GhVariables
|
, variables = GhVariables
|
||||||
{ owner = owner
|
{ owner = owner
|
||||||
, name = name
|
, name = name
|
||||||
|
, prefix = if Text.null prefix then Nothing else Just $ prefix <> "*"
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
authorizationHeader = header "authorization"
|
authorizationHeader = header "authorization"
|
||||||
@ -242,15 +265,16 @@ latestGitHub PackageOwner{..} pattern' = do
|
|||||||
$ refs
|
$ refs
|
||||||
$ (getField @"repository" :: GhData -> GhRepository)
|
$ (getField @"repository" :: GhData -> GhRepository)
|
||||||
$ responseBody ghResponse
|
$ responseBody ghResponse
|
||||||
refs' = Vector.reverse
|
refs' = Vector.catMaybes
|
||||||
$ Vector.catMaybes
|
|
||||||
$ match pattern' . getField @"name" <$> ghNodes
|
$ match pattern' . getField @"name" <$> ghNodes
|
||||||
pure $ refs' !? 0
|
pure $ refs' !? 0
|
||||||
where
|
where
|
||||||
githubQuery =
|
githubQuery =
|
||||||
"query ($name: String!, $owner: String!) {\n\
|
"query ($name: String!, $owner: String!, $prefix: String) {\n\
|
||||||
\ repository(name: $name, owner: $owner) {\n\
|
\ repository(name: $name, owner: $owner) {\n\
|
||||||
\ refs(last: 10, refPrefix: \"refs/tags/\", orderBy: { field: TAG_COMMIT_DATE, direction: ASC }) {\n\
|
\ refs(first: 10, query: $prefix, refPrefix: \"refs/tags/\", orderBy: {\n\
|
||||||
|
\ field: TAG_COMMIT_DATE, direction: DESC\n\
|
||||||
|
\ }) {\n\
|
||||||
\ nodes {\n\
|
\ nodes {\n\
|
||||||
\ id,\n\
|
\ id,\n\
|
||||||
\ name\n\
|
\ name\n\
|
||||||
|
Loading…
Reference in New Issue
Block a user