Use TOML configuration
This commit is contained in:
@ -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
|
||||
|
@ -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)
|
||||
|
16
app/SlackBuilder/Config.hs
Normal file
16
app/SlackBuilder/Config.hs
Normal file
@ -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
|
@ -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\
|
||||
\}"
|
||||
|
Reference in New Issue
Block a user