Use TOML configuration

.gitignore

@@ -15,12 +15,12 @@
 *.pk3
 *.run
 *.deb
-*.jar
 *~
 .directory
 *.phar
 
 /slackbuilds/
+/config/config.toml
 /config/config.rb
 /vendor/
 /.bundle/

app/Main.hs

@@ -6,14 +6,23 @@ import qualified Data.Text.IO as Text.IO
 import Data.Maybe (fromMaybe)
 import Options.Applicative (execParser)
 import SlackBuilder.CommandLine
+import SlackBuilder.Config
 import SlackBuilder.Updater
+import qualified Toml
+import qualified Data.Text as Text
 
 main :: IO ()
 main = do
     programCommand <- execParser slackBuilderParser
+    settings <- Toml.decodeFile settingsCodec "config/config.toml"
     latestVersion <- case programCommand of
         PackagistCommand packagistArguments ->
             latestPackagist packagistArguments
         TextCommand textArguments -> latestText textArguments
+        GhCommand ghArguments -> latestGitHub settings ghArguments (stripPrefix "v")
 
     Text.IO.putStrLn $ fromMaybe "" latestVersion
+  where
+    stripPrefix prefix string = Just
+        $ fromMaybe string
+        $ Text.stripPrefix prefix string

app/SlackBuilder/CommandLine.hs

@@ -1,5 +1,6 @@
 module SlackBuilder.CommandLine
-    ( SlackBuilderCommand(..)
+    ( GhArguments(..)
+    , SlackBuilderCommand(..)
     , PackagistArguments(..)
     , TextArguments(..)
     , slackBuilderParser
@@ -21,12 +22,18 @@ import Options.Applicative
 data SlackBuilderCommand
     = PackagistCommand PackagistArguments
     | TextCommand TextArguments
+    | GhCommand GhArguments
 
 data PackagistArguments = PackagistArguments
     { vendor :: Text
     , name :: Text
     } deriving (Eq, Show)
 
+data GhArguments = GhArguments
+    { owner :: Text
+    , name :: Text
+    } deriving (Eq, Show)
+
 newtype TextArguments = TextArguments Text
 
 packagistArguments :: Parser PackagistArguments
@@ -37,6 +44,11 @@ packagistArguments = PackagistArguments
 textArguments :: Parser TextArguments
 textArguments = TextArguments <$> argument str (metavar "URL")
 
+ghArguments :: Parser GhArguments
+ghArguments = GhArguments
+    <$> argument str (metavar "OWNER")
+    <*> argument str (metavar "NAME")
+
 slackBuilderParser :: ParserInfo SlackBuilderCommand
 slackBuilderParser = info slackBuilderCommand fullDesc
 
@@ -44,3 +56,4 @@ slackBuilderCommand :: Parser SlackBuilderCommand
 slackBuilderCommand = subparser
     $ command "packagist" (info (PackagistCommand <$> packagistArguments) mempty)
     <> command "text" (info (TextCommand <$> textArguments) mempty)
+    <> command "github" (info (GhCommand <$> ghArguments) mempty)

app/SlackBuilder/Config.hs

@@ -0,0 +1,16 @@
+module SlackBuilder.Config
+    ( Settings(..)
+    , settingsCodec
+    ) where
+
+import Data.Text (Text)
+import Toml ((.=))
+import qualified Toml
+
+newtype Settings = Settings
+    { ghToken :: Text
+    } deriving (Eq, Show)
+
+settingsCodec :: Toml.TomlCodec Settings
+settingsCodec = Settings
+    <$> Toml.text "gh_token" .= ghToken

app/SlackBuilder/Updater.hs

@@ -1,18 +1,23 @@
 module SlackBuilder.Updater
-    ( latestPackagist
+    ( latestGitHub
+    , latestPackagist
     , latestText
     ) where
 
+import SlackBuilder.Config
+import qualified Data.Aeson as Aeson
+import Data.Aeson ((.:))
 import Data.Aeson.TH (defaultOptions, deriveJSON)
 import Data.HashMap.Strict (HashMap)
 import qualified Data.HashMap.Strict as HashMap
 import Data.Text (Text)
 import qualified Data.Text as Text
 import qualified Data.Text.Encoding as Text.Encoding
-import Data.Vector (Vector)
+import Data.Vector (Vector, (!?))
 import qualified Data.Vector as Vector
 import Network.HTTP.Req
-    ( runReq
+    ( header
+    , runReq
     , defaultHttpConfig
     , req
     , GET(..)
@@ -20,10 +25,12 @@ import Network.HTTP.Req
     , jsonResponse
     , NoReqBody(..)
     , (/:)
-    , responseBody, useHttpsURI, bsResponse
+    , responseBody, useHttpsURI, bsResponse, POST (POST), ReqBodyJson (ReqBodyJson)
     )
 import Text.URI (mkURI)
 import SlackBuilder.CommandLine
+import qualified Data.Aeson.KeyMap as KeyMap
+import GHC.Records (HasField(..))
 
 newtype PackagistPackage = PackagistPackage
     { version :: Text
@@ -37,6 +44,48 @@ newtype PackagistResponse = PackagistResponse
 
 $(deriveJSON defaultOptions ''PackagistResponse)
 
+newtype GhRefNode = GhRefNode
+    { name :: Text
+    } deriving (Eq, Show)
+
+$(deriveJSON defaultOptions ''GhRefNode)
+
+newtype GhRef = GhRef
+    { nodes :: Vector GhRefNode
+    } deriving (Eq, Show)
+
+$(deriveJSON defaultOptions ''GhRef)
+
+newtype GhRepository = GhRepository
+    { refs :: GhRef
+    } deriving (Eq, Show)
+
+$(deriveJSON defaultOptions ''GhRepository)
+
+newtype GhData = GhData
+    { repository :: GhRepository
+    } deriving (Eq, Show)
+
+instance Aeson.FromJSON GhData where
+    parseJSON (Aeson.Object keyMap)
+        | Just data' <- KeyMap.lookup "data" keyMap =
+            GhData <$> Aeson.withObject "GhData" (.: "repository") data'
+    parseJSON v = fail "data key not found in the response"
+
+data GhVariables = GhVariables
+    { name :: Text
+    , owner :: Text
+    } deriving (Eq, Show)
+
+$(deriveJSON defaultOptions ''GhVariables)
+
+data GhQuery = GhQuery
+    { query :: Text
+    , variables :: GhVariables
+    } deriving (Eq, Show)
+
+$(deriveJSON defaultOptions ''GhQuery)
+
 latestPackagist :: PackagistArguments -> IO (Maybe Text)
 latestPackagist PackagistArguments{..} = do
     packagistResponse <- runReq defaultHttpConfig $
@@ -59,3 +108,37 @@ latestText (TextArguments textArguments) = do
         <$> packagistResponse
   where
     go uri = req GET uri NoReqBody bsResponse mempty
+
+latestGitHub :: Settings -> GhArguments -> (Text -> Maybe Text) -> IO (Maybe Text)
+latestGitHub Settings{..} GhArguments{..} versionTransform = do
+    ghResponse <- runReq defaultHttpConfig $
+        let uri = https "api.github.com" /: "graphql"
+            query = GhQuery
+                {  query = githubQuery
+                , variables = GhVariables
+                    { owner = owner
+                    , name = name
+                    }
+                }
+            authorizationHeader = header "authorization"
+                $ Text.Encoding.encodeUtf8
+                $ "Bearer " <> ghToken
+         in req POST uri (ReqBodyJson query) jsonResponse
+            $ authorizationHeader <> header "User-Agent" "SlackBuilder"
+    let ghNodes = nodes $ refs $ repository $ responseBody ghResponse
+        refs' = Vector.reverse
+            $ Vector.catMaybes
+            $ versionTransform . getField @"name" <$> ghNodes
+    pure $ refs' !? 0
+  where
+    githubQuery =
+        "query ($name: String!, $owner: String!) {\n\
+        \  repository(name: $name, owner: $owner) {\n\
+        \    refs(last: 10, refPrefix: \"refs/tags/\", orderBy: { field: TAG_COMMIT_DATE, direction: ASC }) {\n\
+        \      nodes {\n\
+        \        id,\n\
+        \        name\n\
+        \      }\n\
+        \    }\n\
+        \  }\n\
+        \}"

config/config.toml.example

@@ -0,0 +1 @@
+gh_token = ""

lib/up2date.rb

@@ -36,7 +36,7 @@ module SlackBuilder
     GQL
     private_constant :GITHUB_QUERY
 
-    def initialize(owner, name, version_transform = ->(v) { v.delete_prefix 'v' })
+    def initialize(owner, name, version_transform = nil)
       super()
 
       @owner = owner
@@ -45,6 +45,16 @@ module SlackBuilder
     end
 
     def latest
+      if @version_transform.nil?
+        `./bin/slackbuilder github #{@owner} #{@name}`.strip
+      else
+        latest_with_transform
+      end
+    end
+
+    private
+
+    def latest_with_transform
       post_data = {
         'query' => GITHUB_QUERY,
         'variables' => { 'name' => @name, 'owner' => @owner }
@@ -57,8 +67,6 @@ module SlackBuilder
       filter_versions_from_response JSON.parse(response.body)
     end
 
-    private
-
     def filter_versions_from_response(response)
       response['data']['repository']['refs']['nodes']
         .map { |node| @version_transform.call node['name'] }

slackbuilder.cabal

@@ -1,13 +1,11 @@
-cabal-version:      2.4
+cabal-version: 2.4
-name:               slackbuilder
+name: slackbuilder
-version:            0.1.0.0
+version: 0.1.0.0
-
--- A short (one-line) description of the package.
--- synopsis:
 
 -- A longer description of the package.
 -- description:
 
+synopsis: Slackware build scripts and configuration files.
 bug-reports: https://git.caraus.tech/OSS/slackbuilder/issues
 
 license: MPL-2.0
@@ -21,15 +19,19 @@ category: Build
 extra-source-files: CHANGELOG.md
 
 executable slackbuilder
-    main-is:          Main.hs
+    main-is: Main.hs
 
     other-modules:
         SlackBuilder.CommandLine
+        SlackBuilder.Config
         SlackBuilder.Updater
     default-extensions:
+        DataKinds
+        DuplicateRecordFields
         OverloadedStrings
         RecordWildCards
         TemplateHaskell
+        TypeApplications
     build-depends:
         aeson ^>= 2.2.0,
         base ^>= 4.16.4.0,
@@ -38,7 +40,8 @@ executable slackbuilder
         optparse-applicative ^>= 0.18.1,
         req ^>=3.13,
         text ^>= 2.0,
+        tomland ^>= 1.3.3,
         unordered-containers ^>= 0.2.19,
         vector ^>= 0.13.0
-    hs-source-dirs:   app
+    hs-source-dirs: app
     default-language: Haskell2010