diff --git a/lib/SlackBuilder/LatestVersionCheck.hs b/lib/SlackBuilder/LatestVersionCheck.hs index 82142e6..ad8d6b8 100644 --- a/lib/SlackBuilder/LatestVersionCheck.hs +++ b/lib/SlackBuilder/LatestVersionCheck.hs @@ -46,6 +46,8 @@ import qualified Data.Aeson.KeyMap as KeyMap import GHC.Records (HasField(..)) import Control.Monad.Trans.Reader (asks) import Control.Monad.IO.Class (MonadIO(..)) +import Control.Applicative (Applicative(liftA2)) +import Data.Char (isAlpha) data PackageOwner = PackageOwner { owner :: Text @@ -66,8 +68,25 @@ data MatchToken | OneOfMatchToken [Char] deriving (Eq, Show) --- | Removes the leading "v" from the version string and returns the result if --- it looks like a version. +-- | Matches a string (for example a version name or CVS tag) against a pattern. +-- 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 fullPattern input = case Text.foldl' go (Just startState) input of @@ -207,6 +226,7 @@ instance Aeson.FromJSON GhData where data GhVariables = GhVariables { name :: Text , owner :: Text + , prefix :: Maybe Text } deriving (Eq, Show) $(deriveJSON defaultOptions ''GhVariables) @@ -226,11 +246,14 @@ latestGitHub PackageOwner{..} pattern' = do ghToken' <- SlackBuilderT $ asks ghToken ghResponse <- runReq defaultHttpConfig $ let uri = https "api.github.com" /: "graphql" + prefix = Text.takeWhile isAlpha + $ Text.filter (liftA2 (&&) (/= ')') (/= '(')) pattern' query = GhQuery { query = githubQuery , variables = GhVariables { owner = owner , name = name + , prefix = if Text.null prefix then Nothing else Just $ prefix <> "*" } } authorizationHeader = header "authorization" @@ -242,15 +265,16 @@ latestGitHub PackageOwner{..} pattern' = do $ refs $ (getField @"repository" :: GhData -> GhRepository) $ responseBody ghResponse - refs' = Vector.reverse - $ Vector.catMaybes + refs' = Vector.catMaybes $ match pattern' . getField @"name" <$> ghNodes pure $ refs' !? 0 where githubQuery = - "query ($name: String!, $owner: String!) {\n\ + "query ($name: String!, $owner: String!, $prefix: String) {\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\ \ id,\n\ \ name\n\